QBasic OS

[qbkiller101]

Hi,
I’m an amateur QBasic programmer and I’m developing a text-based operating system like thing but I’m stuck at two things, 1) when a user types a command (like ms-dos) the os responds with the required action but I can't put an if or case statement with all possible commands after all input statements as that would be too long. 2) how to create a virtual machine that would boot with the .bas file or with qb64 in which I will run the file. Please help.

(Please don't make fun just tell me how to as everyone makes fun for creating a QBasic OS)

[TempodiBasic]

Hi qbkiller101

welcome to the forum of QB64

just about your issue... I must say 3 simple concepts:

1. QBasic and also QB64 are not the more suitable language for build up an Operative System.
Think that an OS must manage file system, RAM, VideoRAM, hardware devices .... often at this level you must manage bits and bytes!
Moreover also the simplest OS must be efficient and  fast.... It seems that the walking from Basic Source code to ASM pseudocode to binary code is not so linear and easy to manage as result in terms of speed and efficacy per QB/Qbasic!
In QB64 you must put in this line  of compiling  the translation from QB64 to C++ and then the compiling of C++ to bynary code. Another extra step that can make difference in results.

2.
about

I can't put an if or case statement with all possible commands after all input statements as that would be too long

what kind of project have you raised up for Qbasic OS?
I think that there are more commands in QB64 then in your thought Qbasic OS... and the parser of QB64 can manage it istantanely (see syntax check while you're typing code)

3.
about

how to create a virtual machine that would boot with the .bas file or with qb64 in which I will run the file.

This is an ambitious goal that lets me think about Commodore 64 that I remember has a BASIC in its ROMS.
A QB64 Machine like the Java Machine that all we have on our PC, notebook, netbook , smartphone etc etc.

In this case yoo must project a layer of interface between your QB64 machine and the other  OS that hosts the QB64 machine. An API as DLL or similar to translate (ask and get feedback) the requests of QB64 machine to Windows or/and  MAC or/and Linux  or/and Android.

My suggestions are:
for QB64 OS alone...study the hardware on  common machine and see how you can manage using QB64
for QB64 virtual machine...
study the service that the host OS uses to manage hardware and how you can access to those service to build an interface for QB64 machine. Then make a  project of a minimal Qbasic OS.
You can study the Commodore system to have an example.
These are my two cents.
More experienced coders can give you more suggestions and tips.

C64 OS https://en.wikipedia.org/wiki/Commodore_64#BASIC

[luke]

I wrote a quick shell program:

Code: [Select]

$CONSOLE:ONLY
_DEST _CONSOLE
IF NOT _DIREXISTS("/var/lib/qenv") THEN MKDIR "/var/lib/qenv"
CHDIR "/var/lib/qenv"

PRINT "READY"

DO
    PRINT "> ";
    LINE INPUT in$
    REDIM parts$(0)
    split in$, " ", parts$()
    IF UBOUND(parts$) = -1 THEN _CONTINUE
    SELECT CASE LCASE$(parts$(0))
        CASE "echo"
            PRINT join$(parts$(), " ", 1)
        CASE "dir"
            SHELL "ls"
        CASE "cd"
            CHDIR "/var/lib/qenv/" + parts$(1)
        CASE "write"
            OPEN parts$(1) FOR OUTPUT AS #1
            PRINT #1, join$(parts$(), " ", 2)
            CLOSE #1
        CASE "type"
            OPEN parts$(1) FOR BINARY AS #1
            s$ = SPACE$(LOF(1))
            GET #1, , s$
            PRINT s$;
            CLOSE #1
        CASE "del"
            KILL parts$(1)
        CASE ELSE
            PRINT "?"
    END SELECT
LOOP

SUB split (in$, delimiter$, result$())
    REDIM result$(-1)
    start = 1
    DO
        WHILE MID$(in$, start, 1) = delimiter$
            start = start + 1
            IF start > LEN(in$) THEN EXIT SUB
        WEND
        finish = INSTR(start, in$, delimiter$)
        IF finish = 0 THEN finish = LEN(in$) + 1
        REDIM _PRESERVE result$(0 TO UBOUND(result$) + 1)
        result$(UBOUND(result$)) = MID$(in$, start, finish - start)
        start = finish + 1
    LOOP WHILE start <= LEN(in$)
END SUB

FUNCTION join$ (in$(), delimiter$, offset)
    result$ = in$(LBOUND(in$) + offset)
    FOR i = LBOUND(in$) + 1 + offset TO UBOUND(in$)
        result$ = result$ + delimiter$ + in$(i)
    NEXT i
    join$ = result$
END FUNCTION
Then did some cruel and unusual things to a minimal Debian install in VirtualBox. See the resulting screen capture.

If anything, I'd say it's rather convincing.

[TempodiBasic]

Thanks Luke
the video is very interesting and impressive...


MKDIR, CHDIR, RMDIR, KILL, SHELL cmdline, NAME , FILES are the built-in file system of Qbasic to which we can add _FILEEXISTS of QB64.
The rest stands to the developer of Qbasic OS.

PS about FILE....
it is a very pity to have a internal command that works only just the old Qbasic command (useful in the old system where it is impossible to think to have so more files on the supports) and its output isn't addressable to other thing than screen... no clipboard , no file.
But do who QB64 coder  likes  get directory content into clipoboard or file? Only just to a lazy coder like me. ;)

[qbkiller101]

Sorry but as i have told

I’m an amateur QBasic programmer

[/font]
Please can luke explain the code as i cant understand

Code: QB64: [Select]

1. $CONSOLE:ONLY
2. _DEST _CONSOLE
3. IF NOT _DIREXISTS("/var/lib/qenv") THEN MKDIR "/var/lib/qenv"
4. CHDIR "/var/lib/qenv"
5.  
6. PRINT "READY"

and

Code: QB64: [Select]

1. SUB split (in$, delimiter$, result$())
2.     REDIM result$(-1)
3.     start = 1
4.     DO
5.         WHILE MID$(in$, start, 1) = delimiter$
6.             start = start + 1
7.             IF start > LEN(in$) THEN EXIT SUB
8.         WEND
9.         finish = INSTR(start, in$, delimiter$)
10.         IF finish = 0 THEN finish = LEN(in$) + 1
11.         REDIM _PRESERVE result$(0 TO UBOUND(result$) + 1)
12.         result$(UBOUND(result$)) = MID$(in$, start, finish - start)
13.         start = finish + 1
14.     LOOP WHILE start <= LEN(in$)
15. END SUB
16.  
17. FUNCTION join$ (in$(), delimiter$, offset)
18.     result$ = in$(LBOUND(in$) + offset)
19.     FOR i = LBOUND(in$) + 1 + offset TO UBOUND(in$)
20.         result$ = result$ + delimiter$ + in$(i)
21.     NEXT i
22.     join$ = result$
23. END FUNCTION

and a simple explanation of the middle part
you can email if you like
omerhijazi@outlook.com

[qbkiller101]

I'm an amateur, amateur QBasic programmer and I'm not even good in loops
So please a little detailed explanation

[TerryRitchie]

I'm an amateur, amateur QBasic programmer and I'm not even good in loops
So please a little detailed explanation

Welcome to the forum! :)

In your first post you state that you are developing a text based OS. Most code (if not all code) people are going to post to help you with your journey is going to be at least a little above beginner level. Perhaps, as a suggestion, before starting with something as ambitious as a text based OS you go through some programming tutorials to get a feel for what programming is and how to structure code.

Here are some Qbasic tutorials to get you started:

[ Invalid YouTube link ]&feature=emb_logo

Here are some totorials I created for QB64:

http://qb64sourcecode.com/

I wrote those tutorials back when QB64 was hosted on [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] so disregard any links you may see that point there.

Since Qbasic is a direct descendant of QB64 what you learn in those tutorials will work 100% for you in QB64.

I'm not trying to be flippant or discourage you in any way, I'm very happy someone else has decided to learn programming using QB64. It's just that without a foundation in the language and coding in general I'm afraid you'll get frustrated very quickly and decide to leave programming entirely.

Go through the tutorials and post questions you have about what you learned. You'll be surprised at how quickly the BASIC language can be learned.

Sincerely, Terry.

[bplus]

I am not Luke (I am his father ha, ha!) but here are some comments

Code: QB64: [Select]

1. $CONSOLE:ONLY
2. ' ^^^^^^^^^^^^^^ set up console window
3. _DEST _CONSOLE ' <<< send output to console window
4. IF NOT _DIREXISTS("/var/lib/qenv") THEN MKDIR "/var/lib/qenv" ' <<< if the directory (folder) does not exit make it
5. CHDIR "/var/lib/qenv" ' <<< now change the working directory to that folder  if you know DOS you know current directory  CD command
6.  
7. PRINT "READY"
8.  
9.  
10.  

Code: QB64: [Select]

1. 'say we have
2. weekDays$ = "Moonday Tuesday Wednesday Thursday Friday Saturday Sunday" ' ha Moonday
3. 'say the delimiter is a space
4. ' call the split sub
5. REDIM daynames$(0)  ' split needs to work with dynamic arrays (you can change their size and dim with REDIM not DIM)
6. split weekDays$, " ", daynames$()
7. 'result
8. PRINT "DayNames array:"
9. FOR i = LBOUND(daynames$) TO UBOUND(daynames$)
10.     PRINT i, daynames$(i)
11. NEXT
12.  
13. ' split is a parser SUB
14. ' this sub takes a string as input =in$ and splits it into segments according to the delimiter often a space
15. ' these fragments are put into the string array result$()
16. SUB split (in$, delimiter$, result$())
17.     REDIM result$(-1) ' <<< wants base zero so starts below  and clears array contents
18.     start = 1
19.     DO
20.         WHILE MID$(in$, start, 1) = delimiter$
21.             start = start + 1
22.             IF start > LEN(in$) THEN EXIT SUB
23.         WEND
24.         finish = INSTR(start, in$, delimiter$)
25.         IF finish = 0 THEN finish = LEN(in$) + 1
26.         REDIM _PRESERVE result$(0 TO UBOUND(result$) + 1)
27.         result$(UBOUND(result$)) = MID$(in$, start, finish - start)
28.         start = finish + 1
29.     LOOP WHILE start <= LEN(in$)
30. END SUB
31.  
32. ' this SUB reverses what Split did taking part of an array starting at offset item and making a long
33. 'string of those remaining items from offset on  << EDIT this line for better interpretation
34. FUNCTION join$ (in$(), delimiter$, offset)
35.     result$ = in$(LBOUND(in$) + offset)
36.     FOR i = LBOUND(in$) + 1 + offset TO UBOUND(in$)
37.         result$ = result$ + delimiter$ + in$(i)
38.     NEXT i
39.     join$ = result$
40. END FUNCTION

[Qwerkey]

Very helpful suggestions from Terry.

[qbkiller101]

Extremely thankful for your help guys
just showing you
here's the prototype sorta thing.
before seeing the code run the .exe file and think how nice or bad the code will look like (you'll be shocked)
anyways... after taking in all the advice I'll update the code.
and if you want you can edit it to show each other
freeware sorta thing... you know
why would an 11-year-old want to copyright or something???!

this is the os
https://drive.google.com/open?id=19tvV0Pq_L3-ZdGQvuO0HzFwGsjYjWL9R

[bplus]

Uh, how does it know?

OK spoiler alert:

Code: QB64: [Select]

1. unc$ = "abc"
2. pwc% = 123
3.  

Ok it works played a nice game of TTT

[qbkiller101]

Oh, I forgot to mention two things.
1) you need to enter the password and username you like in unc and pwc
2) see the code of TTT

Code: QB64: [Select]

1. PRINT "Credits"
2. PRINT "-------"
3. PRINT "This game was created by Paul Meyer in the year 2007."
4. PRINT: PRINT "Graphics by TheBob"
5. PRINT: PRINT "Improved mouse driver, modularity, machine play-to-win";
6. PRINT " by QBasic Mac"
7. PRINT: PRINT "History:"
8. PRINT "http://www.network54.com/Forum/190883/message/1175106480"
9. PRINT
10. PRINT "This is freeware, you may change this as much as you want"
11. PRINT "as long as you don't claim it as yours."
12.  

[qbkiller101]

Unfortunately the website doesnt exist

[SMcNeill]

Unfortunately the website doesnt exist

Network54 still exists.  Their forums simply got absorbed by TapaTalk, like tons of other old ones.  You can probably find your old link here somewhere: https://www.tapatalk.com/groups/qbasic/index.php

[EricE]

Is this the code?

Code: QB64: [Select]

1. DECLARE FUNCTION XWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
2. DECLARE FUNCTION OWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
3. DECLARE SUB Winner (Lineup AS INTEGER)
4. DECLARE SUB ShowWin (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER)
5. DECLARE SUB GetUserSignal ()
6. DECLARE SUB EnableMouse (c%)
7. DECLARE SUB DrawSCREEN ()
8. DECLARE SUB xo (Row%, Col%, symbol%)
9.  
10. DIM SHARED False AS INTEGER, True AS INTEGER: True = NOT False
11. DIM SHARED SymbolBOX(6000) AS INTEGER '<---NOTE
12.  
13. DIM SHARED cH AS INTEGER: 'Cursor Position Horizontal
14. DIM SHARED cV AS INTEGER: 'Cursor Position Vertical
15. DIM SHARED click AS INTEGER: ' 0=no click, 1=left click, 2=right
16. ' EnableMouse 1 = Turn cursor on, return coordinates
17. ' EnableMouse 0 = Turn cursor off in order to draw stuff, etc.
18. DIM SHARED cC AS STRING: 'User pressed key
19. ' GetUserSignal will set return cC or will return Click
20.  
21. DIM i AS INTEGER, j AS INTEGER, k AS INTEGER
22. DIM WhoWon AS INTEGER
23. DIM MadeAMove AS INTEGER, MovesMade AS INTEGER
24.  
25. ' ----------------------------------------------------------
26. ' Title Screen (Main Program)
27. ' -----------------------------------------------------------
28. SCREEN 12
29. RANDOMIZE TIMER
30. DIM Command AS INTEGER, Hard AS INTEGER
31. GOSUB InitializeScreen
32. DO
33. DO: GetUserSignal: LOOP UNTIL click = 1
34. GOSUB FindClickedCommand
35. SELECT CASE Command
36. CASE 1:
37. Hard = False
38. WhoWon = 0
39. GOSUB PlayGame
40. GOSUB ShowWhoWon
41. GOSUB InitializeScreen
42. CASE 2:
43. Hard = True
44. WhoWon = 0
45. GOSUB PlayGame
46. GOSUB ShowWhoWon
47. GOSUB InitializeScreen
48. CASE 3:
49. GOSUB DoHelp
50. GOSUB InitializeScreen
51. CASE 4:
52. EXIT DO
53. END SELECT
54. LOOP
55. COLOR 7: CLS
56. SYSTEM
57.  
58. ' ----------------------------------------------------------
59. ' Game Screen
60. ' -----------------------------------------------------------
61. DIM SHARED zX(9) AS INTEGER: ' Where all X's are placed
62. DIM SHARED zO(9) AS INTEGER: ' Where all O's are placed
63. DIM SHARED zE(9) AS INTEGER: ' Where empty squares are
64. DIM theRow AS INTEGER, theColumn AS INTEGER, theBox AS INTEGER
65.  
66. FindClickedPosition:
67. CONST Delta = 4
68. theRow = 0: theColumn = 0: theBox = 0
69. SELECT CASE cH
70. CASE IS < 170 + Delta: RETURN
71. CASE IS < 269 - Delta: theColumn = 1
72. CASE IS < 269 + Delta: RETURN
73. CASE IS < 368 - Delta: theColumn = 2
74. CASE IS < 368 + Delta: RETURN
75. CASE IS < 467 - Delta: theColumn = 3
76. CASE ELSE: RETURN
77. END SELECT
78. SELECT CASE cV
79. CASE IS < 91 + Delta: RETURN
80. CASE IS < 190 - Delta: theRow = 1
81. CASE IS < 190 + Delta: RETURN
82. CASE IS < 289 - Delta: theRow = 2
83. CASE IS < 289 + Delta: RETURN
84. CASE IS < 388 - Delta: theRow = 3
85. CASE ELSE: RETURN
86. END SELECT
87. theBox = (3 * (theRow - 1)) + theColumn
88. RETURN
89.  
90. ' ----------------------------------------------------------
91. ' Play Game
92. ' -----------------------------------------------------------
93. PlayGame:
94. DrawSCREEN 'draw the screen and create X and O symbols.
95. FOR i = 1 TO 9: zO(i) = False: zX(i) = False: zE(i) = True: NEXT i
96. MovesMade = 0
97. DO
98. GetUserSignal
99. IF click THEN
100. MadeAMove = False
101. GOSUB MakeX
102. IF MadeAMove THEN
103. WhoWon = 1: GOSUB ComputeWin: IF WhoWon = 1 THEN RETURN
104. t% = 0
105. FOR i = 1 TO 9: t% = t% + zX(i): NEXT i
106. IF t% = -5 THEN WhoWon = 0: RETURN
107. MovesMade = MovesMade + 1
108. GOSUB MakeO
109. WhoWon = 2: GOSUB ComputeWin: IF WhoWon = 2 THEN RETURN
110. END IF
111. END IF
112. IF cC = "d" OR cC = CHR$(27) THEN WhoWon = 3
113. IF WhoWon > 0 THEN RETURN
114. LOOP
115.  
116. MakeX:
117. GOSUB FindClickedPosition
118. IF theBox = 0 THEN RETURN
119. IF NOT zE(theBox) THEN RETURN
120. xo theRow, theColumn, 1: ' Places an X
121. zX(theBox) = True: zE(theBox) = False
122. MadeAMove = True
123. RETURN
124.  
125. MakeO:
126. GOSUB FindPlaceForO
127. SLEEP 1: WHILE INKEY$ <> "": WEND
128. xo theRow, theColumn, 0: 'Places an O
129. zO(theBox) = True: zE(theBox) = False
130. RETURN
131.  
132. ComputeWin:
133. IF WhoWon = 1 THEN
134. IF XWin(1, 2, 3, 1) THEN RETURN
135. IF XWin(4, 5, 6, 2) THEN RETURN
136. IF XWin(7, 8, 9, 3) THEN RETURN
137. IF XWin(1, 4, 7, 4) THEN RETURN
138. IF XWin(2, 5, 8, 5) THEN RETURN
139. IF XWin(3, 6, 9, 6) THEN RETURN
140. IF XWin(1, 5, 9, 7) THEN RETURN
141. IF XWin(3, 5, 7, 8) THEN RETURN
142. ELSE
143. IF OWin(1, 2, 3, 1) THEN RETURN
144. IF OWin(4, 5, 6, 2) THEN RETURN
145. IF OWin(7, 8, 9, 3) THEN RETURN
146. IF OWin(1, 4, 7, 4) THEN RETURN
147. IF OWin(2, 5, 8, 5) THEN RETURN
148. IF OWin(3, 6, 9, 6) THEN RETURN
149. IF OWin(1, 5, 9, 7) THEN RETURN
150. IF OWin(3, 5, 7, 8) THEN RETURN
151. END IF
152. WhoWon = 0
153. RETURN
154.  
155. FindPlaceForO:
156. ' See if there is a win for O. If so, take it.
157. ' See if there is a threat of a win for X. If so, block it.
158. FOR TestType% = 1 TO 2
159. theBox = 0
160. FOR theRow = 1 TO 3: FOR theColumn = 1 TO 3
161. theBox = theBox + 1
162. IF zE(theBox) THEN
163. tk$ = ""
164. SELECT CASE theBox
165. CASE 1: tk$ = "234759"
166. CASE 2: tk$ = "1358"
167. CASE 3: tk$ = "126957"
168. CASE 4: tk$ = "1756"
169. CASE 5: tk$ = "19283746"
170. CASE 6: tk$ = "4539"
171. CASE 7: tk$ = "148935"
172. CASE 8: tk$ = "2579"
173. CASE 9: tk$ = "153678"
174. END SELECT
175. FOR i = 1 TO LEN(tk$) STEP 2
176. j = VAL(MID$(tk$, i, 1))
177. k = VAL(MID$(tk$, i + 1, 1))
178. IF TestType% = 1 THEN
179. IF zO(j) + zO(k) < -1 THEN RETURN
180. ELSE
181. IF zX(j) + zX(k) < -1 THEN RETURN
182. END IF
183. NEXT i
184. END IF
185. NEXT theColumn: NEXT theRow
186. NEXT TestType%
187. ' No move selected above to win or block win, so
188. IF Hard THEN
189. IF MovesMade = 1 THEN
190. IF zE(5) THEN
191. theRow = 2: theColumn = 2: theBox = 5
192. ELSE
193. IF RND > .5 THEN theRow = 1 ELSE theRow = 3
194. IF RND > .5 THEN theColumn = 1 ELSE theColumn = 3
195. theBox = (3 * (theRow - 1)) + theColumn
196. END IF
197. RETURN
198. ELSEIF MovesMade = 2 THEN
199. IF zX(5) THEN
200. tk$ = ""
201. IF zO(1) AND zX(9) THEN
202. tk$ = "37"
203. ELSEIF zO(3) AND zX(7) THEN
204. tk$ = "19"
205. ELSEIF zO(7) AND zX(3) THEN
206. tk$ = "19"
207. ELSEIF zO(9) AND zX(1) THEN
208. tk$ = "37"
209. END IF
210. IF tk$ <> "" THEN
211. IF RND > .5 THEN
212. theBox = VAL(LEFT$(tk$, 1))
213. ELSE
214. theBox = VAL(LEFT$(tk$, 1))
215. END IF
216. theRow = (theBox + 2) \ 3
217. theColumn = theBox - (3 * (theRow - 1))
218. RETURN
219. END IF
220. ELSE
221. DO
222. DO: theBox = 2 * INT(1 + (RND * 4)): LOOP WHILE NOT zE(theBox)
223. SELECT CASE theBox
224. CASE 2: IF NOT zX(8) THEN EXIT DO
225. CASE 4: IF NOT zX(6) THEN EXIT DO
226. CASE 6: IF NOT zX(4) THEN EXIT DO
227. CASE 8: IF NOT zX(2) THEN EXIT DO
228. END SELECT
229. LOOP
230. theRow = (theBox + 2) \ 3
231. theColumn = theBox - (3 * (theRow - 1))
232. RETURN
233. END IF
234. END IF
235. END IF
236. ' OK, no good move was found. Make a random one
237. DO: theBox = 1 + INT(RND * 9): LOOP WHILE NOT zE(theBox)
238. theRow = (theBox + 2) \ 3
239. theColumn = theBox - (3 * (theRow - 1))
240. RETURN
241.  
242. Shuffle:
243. DO WHILE LEN(w1$) < 4
244. r% = 1 + INT(RND * 4)
245. IF MID$(w2$, r%, 1) <> "x" THEN
246. w1$ = w1$ + MID$(w2$, r%, 1)
247. MID$(w2$, r%, 1) = "x"
248. END IF
249. LOOP
250. RETURN
251.  
252. ShowWhoWon:
253. SELECT CASE WhoWon
254. CASE 0: c$ = "Tie! "
255. CASE 1: c$ = "YOU WIN! "
256. CASE 2: c$ = "YOU LOSE! "
257. CASE 3: c$ = "YOU RESIGNED?"
258. END SELECT
259. IF WhoWon < 3 THEN SLEEP 2: WHILE INKEY$ <> "": WEND
260. CLS
261. FOR i = 1 TO 30
262. COLOR 1 + INT(RND * 15)
263. LOCATE i, i + 20
264. PRINT c$;
265. NEXT i
266. SLEEP 3: WHILE INKEY$ <> "": WEND
267. RETURN
268.  
269. InitializeScreen:
270. CLS
271. COLOR 15
272. LOCATE 4, 23: PRINT "TIC TAC TOE by Paul Meyer & TheBOB"
273. LOCATE 6, 27: PRINT "(C) 2004 - 2007 Dos-Id Games"
274. COLOR 3
275. ds% = 131: dd% = 97: dz% = 75
276. LINE (ds%, 343)-(ds% + dz%, 380), , BF
277. LINE (ds% + (1 * dd%), 343)-(ds% + (1 * dd%) + dz%, 380), , BF
278. LINE (ds% + (2 * dd%), 343)-(ds% + (2 * dd%) + dz%, 380), , BF
279. LINE (ds% + (3 * dd%), 343)-(ds% + (3 * dd%) + dz%, 380), , BF
280. LOCATE 23, 19: PRINT " Easy ";
281. LOCATE , 31: PRINT " Hard ";
282. LOCATE , 43: PRINT " Info ";
283. LOCATE , 55: PRINT " Quit "
284. RETURN
285.  
286. FindClickedCommand:
287. Command = 0
288. SELECT CASE cV
289. CASE IS < 343: RETURN
290. CASE IS > 380: RETURN
291. END SELECT
292. SELECT CASE cH
293. CASE IS < 130: RETURN
294. CASE IS < 205: Command = 1
295. CASE IS < 227: RETURN
296. CASE IS < 303: Command = 2
297. CASE IS < 325: RETURN
298. CASE IS < 400: Command = 3
299. CASE IS < 421: RETURN
300. CASE IS < 497: Command = 4
301. END SELECT
302. RETURN
303.  
304.  
305. DoHelp:
306. CLS
307. COLOR 2
308. LOCATE 3, 1
309. PRINT "Credits"
310. PRINT "-------"
311. PRINT "This game was created by Paul Meyer in the year 2007."
312. PRINT : PRINT "Graphics by TheBob"
313. PRINT : PRINT "Improved mouse driver, modularity, machine play-to-win";
314. PRINT " by QBasic Mac"
315. PRINT : PRINT "History:"
316. PRINT "http://www.network54.com/Forum/190883/message/1175106480"
317. PRINT
318. PRINT "This is freeware, you may change this as much as you want"
319. PRINT "as long as you don't claim it as yours."
320. PRINT
321. PRINT
322. PRINT "About"
323. PRINT "-----"
324. PRINT "This is just a simple TIC TAC TOE game with mouse drivers."
325. PRINT "This game was created in QuickBasic."
326. CALL GetUserSignal
327. CLS
328. RETURN
329.  
330. SUB DrawSCREEN
331. DIM x AS INTEGER, y AS INTEGER
332. STATIC Finished AS INTEGER
333. CLS
334. OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 18
335. OUT &H3C8, 4: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
336. OUT &H3C8, 9: OUT &H3C9, 0: OUT &H3C9, 12: OUT &H3C9, 48
337. OUT &H3C8, 11: OUT &H3C9, 0: OUT &H3C9, 18: OUT &H3C9, 54
338. COLOR 7: LOCATE 3, 31: PRINT "T I C - T A C - T O E"
339. LINE (170, 90)-(490, 410), 0, BF
340. LINE (160, 81)-(479, 399), 1, BF
341. LINE (155, 76)-(483, 404), 8, B
342. LINE (152, 73)-(487, 407), 8, B
343. LINE (160, 81)-(160, 399), 9
344. LINE (160, 81)-(479, 81), 9
345. LINE (371, 92)-(372, 393), 0, B
346. LINE (271, 92)-(272, 392), 0, B
347. LINE (171, 191)-(472, 192), 0, B
348. LINE (171, 291)-(472, 292), 0, B
349. LINE (369, 90)-(370, 390), 13, B
350. LINE (269, 90)-(270, 390), 13, B
351. LINE (169, 189)-(470, 190), 13, B
352. LINE (169, 289)-(470, 290), 13, B
353. LINE (5, 5)-(634, 474), 8, B
354. LINE (10, 10)-(629, 469), 8, B
355. IF Finished THEN EXIT SUB
356. Finished = True
357. FOR x = 194 TO 500
358. FOR y = 32 TO 46
359. IF POINT(x, y) = 8 THEN PSET (x, y), 7
360. NEXT y
361. NEXT x
362. PSET (188, 108), 0
363. DRAW "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P0,0"
364. PSET (186, 106), 10
365. DRAW "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P10,10"
366. CIRCLE (322, 141), 31, 0
367. CIRCLE (322, 141), 37, 0
368. PAINT STEP(0, 35), 0
369. PSET STEP(0, -35), 0
370. CIRCLE (320, 139), 31, 4
371. CIRCLE (320, 139), 37, 4
372. PAINT STEP(0, 35), 4
373. PSET STEP(0, -35), 1
374. GET STEP(-40, -40)-STEP(81, 81), SymbolBOX
375. GET (179, 98)-(260, 178), SymbolBOX(3000)
376. xo 1, 1, 2: xo 1, 2, 2
377. END SUB
378.  
379. SUB EnableMouse (c%)
380. STATIC Status AS INTEGER
381. IF Status = 0 AND c% = 0 THEN EXIT SUB
382. STATIC Mx AS STRING
383. IF Mx = "" THEN
384. m$ = "58E85080585080585080850815510C358508058508085080850815C00"
385. n$ = "595BECB70BEAB70BE8BFBE6B7B8E7D33BEC978BEA97BE89FBE697DA80"
386. Mx = SPACE$(57)
387. FOR i% = 1 TO 57
388. H$ = CHR$(VAL("&H" + MID$(m$, i%, 1) + MID$(n$, i%, 1)))
389. MID$(Mx, i%, 1) = H$
390. NEXT i%
391. END IF
392. IF c% = 0 THEN
393. CALL Absolute(2, click, cH, cV, SADD(Mx))
394. Status = 0
395. EXIT SUB
396. END IF
397. IF Status = 0 THEN CALL Absolute(1, click, cH, cV, SADD(Mx))
398. Status = 1
399. CALL Absolute(3, click, cH, cV, SADD(Mx))
400. END SUB
401.  
402. SUB GetUserSignal
403. DO
404. IF 0 THEN ' Set to 1 for Debugging printout, otherwise 0
405. LOCATE 2, 1
406. PRINT click; "<Click"
407. PRINT cH; "ch (Horizontal)"
408. PRINT cV; "cv (Verticle)"
409. END IF
410. EnableMouse 1
411. IF click > 0 THEN
412. k% = click
413. WHILE click <> 0: EnableMouse 1: WEND
414. click = k%
415. EXIT DO
416. END IF
417. cC = INKEY$
418. LOOP WHILE cC = ""
419. EnableMouse 0
420. END SUB
421.  
422. FUNCTION OWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
423. IF zO(b1) = 0 OR zO(b2) = 0 OR zO(b3) = 0 THEN EXIT FUNCTION
424. Winner l
425. OWin% = -1
426. END FUNCTION
427.  
428. SUB Winner (Lineup AS INTEGER)
429. SELECT CASE Lineup
430. CASE 1: LINE (200, 140)-(440, 142), 14, BF: LINE (200, 143)-(440, 144), 0, B
431. CASE 2: LINE (200, 240)-(440, 242), 14, BF: LINE (200, 243)-(440, 244), 0, B
432. CASE 3: LINE (200, 340)-(440, 342), 14, BF: LINE (200, 343)-(440, 344), 0, B
433. CASE 4: LINE (220, 120)-(222, 360), 14, BF: LINE (223, 120)-(223, 360), 0
434. CASE 5: LINE (320, 120)-(322, 360), 14, BF: LINE (323, 120)-(323, 360), 0
435. CASE 6: LINE (420, 120)-(422, 360), 14, BF: LINE (423, 120)-(423, 360), 0
436. CASE 7: PSET (200, 120), 14: DRAW "F240 d H240 d F240 d H240 d C0 F240 d H240"
437. CASE 8: PSET (440, 120), 14: DRAW "G240 d E240 d G240 d E240 d C0 G240 d E240"
438. END SELECT
439. END SUB
440.  
441. SUB xo (Row AS INTEGER, Col AS INTEGER, symbol AS INTEGER)
442. DIM Index AS INTEGER, x AS INTEGER, y AS INTEGER
443. x = (Col - 1) * 100 + 180
444. y = (Row - 1) * 100 + 100
445. Index = symbol * 3000
446. IF Index < 6000 THEN
447. PUT (x, y), SymbolBOX(Index), PSET
448. ELSE
449. LINE (x, y)-(x + 80, y + 80), 1, BF
450. END IF
451. END SUB
452.  
453. FUNCTION XWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
454. IF zX(b1) = 0 OR zX(b2) = 0 OR zX(b3) = 0 THEN EXIT FUNCTION
455. Winner l
456. XWin% = -1
457. END FUNCTION