QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: qbkiller101 on March 24, 2020, 05:54:22 am

Title: QBasic OS
Post by: qbkiller101 on March 24, 2020, 05:54:22 am

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)

Title: Re: QBasic OS
Post by: TempodiBasic on March 24, 2020, 07:35:05 am

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

Quote

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

Quote

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 (https://en.wikipedia.org/wiki/Commodore_64#BASIC)

Title: Re: QBasic OS
Post by: luke on March 24, 2020, 09:23:37 am

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.

Title: Re: QBasic OS
Post by: TempodiBasic on March 24, 2020, 11:00:34 am

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. ;)

Title: Re: QBasic OS
Post by: qbkiller101 on March 25, 2020, 05:58:30 am

Sorry but as i have told

Quote from: qbkiller101 on March 24, 2020, 05:54:22 am

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

Title: Re: QBasic OS
Post by: qbkiller101 on March 25, 2020, 06:00:27 am

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

Title: Re: QBasic OS
Post by: TerryRitchie on March 25, 2020, 12:13:30 pm

Quote from: qbkiller101 on March 25, 2020, 06:00:27 am

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.

Title: Re: QBasic OS
Post by: bplus on March 25, 2020, 12:41:36 pm

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

Title: Re: QBasic OS
Post by: Qwerkey on March 25, 2020, 12:43:37 pm

Very helpful suggestions from Terry.

Title: Re: QBasic OS
Post by: qbkiller101 on March 25, 2020, 02:43:09 pm

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

Title: Re: QBasic OS
Post by: bplus on March 25, 2020, 03:19:57 pm

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

Title: Re: QBasic OS
Post by: qbkiller101 on March 26, 2020, 07:41:44 am

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.  

Title: Re: QBasic OS
Post by: qbkiller101 on March 26, 2020, 07:43:15 am

Unfortunately the website doesnt exist

Title: Re: QBasic OS
Post by: SMcNeill on March 26, 2020, 12:33:18 pm

Quote from: qbkiller101 on March 26, 2020, 07:43:15 am

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

Title: Re: QBasic OS
Post by: EricE on March 26, 2020, 01:29:21 pm

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

Title: Re: QBasic OS
Post by: TempodiBasic on March 26, 2020, 05:19:49 pm

Hi Eric
it seems TicTacToe.BAS a Bob Seguin's product for graphics that travels in the sample package of QB64.

PS It has a bug that I fixed... :-)

Title: Re: QBasic OS
Post by: EricE on March 26, 2020, 05:55:04 pm

Hi TempodiBasic,
I found the code by using Google to search for various substrings of this comment string.
"This game was created by Paul Meyer in the year 2007."
I will look for the fixed sample version.

EDIT
And I found it! We all had the improved, fixed version ready for us to use.

C:\qb64_1.4_win-x86\qb64\programs\samples\n54\big\tictac.bas

Title: Re: QBasic OS
Post by: TempodiBasic on March 26, 2020, 06:53:48 pm

Hi Eric
this version that is in the sample package of QB64  has the interface written by Bob Seguin as you can read also if you run it.
Good let run it and then please choose Hard, then as first player make as choice the rightest square (cell) of the middle raw, the AI will respond taking the center with O,  now make as choice the center square of the bottom raw...! You got it! a runtime error for Subscript out of range!
Searching on the [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] you'll find my fix to this.
Or You'll be able to fix following the flow of the program.

Title: Re: QBasic OS
Post by: EricE on March 26, 2020, 09:06:49 pm

Quote

Searching on the [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] you'll find my fix to this

I am sorry to say that I could not find your fix at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there].

[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there] is not complete, there are many links there that just lead back to its main page.

Title: Re: QBasic OS
Post by: qbkiller101 on March 27, 2020, 04:17:27 am

Quote

Is this the code

yeah

Title: Re: QBasic OS
Post by: TempodiBasic on March 29, 2020, 04:34:23 pm

Hey Guys
on an old Notebook I have found my fix to TicTacToe
here is
as attachment

Title: Re: QBasic OS
Post by: EricE on March 29, 2020, 08:21:33 pm

Thank you TempodiBasic,
However, the attachment you uploaded is damaged.
Did it open ok before you uploaded it?

Title: Re: QBasic OS
Post by: qbkiller101 on March 30, 2020, 05:27:35 am

I guess he sort of opened the .exe in qb64 or something cuz that's what happens when you open .exe in text editors or compilers

Title: Re: QBasic OS
Post by: TempodiBasic on March 30, 2020, 07:18:11 am

Hi Eric
sorry that is a QB compressed file

here the text version...

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 ' modalita schermo / screen mode
29. RANDOMIZE TIMER ' inizializza generatore di numeri casuali / it inizializes maker of random numbers
30. DIM Command AS INTEGER, Hard AS INTEGER
31. ' variabili generali non visibili in SUB per cui usa GOSUB
32. ' general variables non seen in SUB so He uses GOSUB
33. GOSUB InitializeScreen ' schermo iniziale con pulsanti / initial screen with buttons
34.  
35. DO ' ciclo principale infinito / main loop infinite
36.     DO: GetUserSignal: LOOP UNTIL click = 1 ' attende il click/ it waits for click
37.     GOSUB FindClickedCommand ' decodifica il click / it decodes click
38.     SELECT CASE Command
39.         CASE 1: ' primo pulsante / first button
40.             Hard = False
41.             WhoWon = 0
42.             GOSUB PlayGame
43.             GOSUB ShowWhoWon
44.             GOSUB InitializeScreen
45.         CASE 2: ' secondo pulsante / second button
46.             Hard = True
47.             WhoWon = 0
48.             GOSUB PlayGame
49.             GOSUB ShowWhoWon
50.             GOSUB InitializeScreen
51.         CASE 3: ' terzo pulsante /third button
52.             GOSUB DoHelp
53.             GOSUB InitializeScreen
54.         CASE 4: 'forth button / quarto pulsante
55.             EXIT DO ' esce dal ciclo/ it exits from loop
56.     END SELECT
57. LOOP
58. COLOR 7: CLS ' ripristina i caratteri bianchi e pulisce lo schermo/ it restores white character and clear screen
59. SYSTEM ' termina liberando le risorse / it stops releasing resources
60.  
61. ' ----------------------------------------------------------
62. ' Game Screen
63. ' -----------------------------------------------------------
64. DIM SHARED zX(9) AS INTEGER: ' Where all X's are placed
65. DIM SHARED zO(9) AS INTEGER: ' Where all O's are placed
66. DIM SHARED zE(9) AS INTEGER: ' Where empty squares are
67. DIM theRow AS INTEGER, theColumn AS INTEGER, theBox AS INTEGER
68.  
69. FindClickedPosition: ' cerca la posizione del mouse/ it finds position of mouse
70. CONST Delta = 4
71. theRow = 0: theColumn = 0: theBox = 0
72. SELECT CASE cH ' posizione orizzontale / horizontal position
73.     CASE IS < 170 + Delta: RETURN
74.     CASE IS < 269 - Delta: theColumn = 1 ' tra 174 e 265 colonna 1 / between 174 and 265 column 1
75.     CASE IS < 269 + Delta: RETURN
76.     CASE IS < 368 - Delta: theColumn = 2 ' tra 274 e 364 colonna 2 / between 274 and 364 column 2
77.     CASE IS < 368 + Delta: RETURN
78.     CASE IS < 467 - Delta: theColumn = 3 ' tra 372 e 463 colonna 3/ between 372 and 463 column 3
79.     CASE ELSE: RETURN
80. END SELECT
81. SELECT CASE cV ' posizione verticale / vertical position
82.     CASE IS < 91 + Delta: RETURN
83.     CASE IS < 190 - Delta: theRow = 1 ' tra 95 e 186 riga 1/ between 95 and 186 row 1
84.     CASE IS < 190 + Delta: RETURN
85.     CASE IS < 289 - Delta: theRow = 2 'tra 194 e 285 riga 2/between 194 3 285 row 2
86.     CASE IS < 289 + Delta: RETURN
87.     CASE IS < 388 - Delta: theRow = 3 ' tra 294 e 384 riga 3 / between 294 e 384 row 3
88.     CASE ELSE: RETURN
89. END SELECT
90. theBox = (3 * (theRow - 1)) + theColumn ' calcola la cella/ it calculates cell
91. ' nota che si possono invertire TheRow e TheColumn nella formula
92. ' see that it can invert TheRow and TheColumn in formula
93. RETURN
94.  
95. ' ----------------------------------------------------------
96. ' Play Game
97. ' -----------------------------------------------------------
98. PlayGame: ' schermata di gioco / screen of game
99. DrawSCREEN 'draw the screen and create X and O symbols.
100. FOR i = 1 TO 9: zO(i) = False: zX(i) = False: zE(i) = True: NEXT i
101. ' inizializza i 3 arrays Empty a vero X e 0 a falso
102. ' it inizializes the three arrays Empty to true   X and 0 to false
103. MovesMade = 0 ' mosse fatte = 0 / moves made = 0
104. DO
105.     GetUserSignal 'aspetta azione utente/ it waits action of user
106.     IF click THEN
107.         MadeAMove = False ' flag fatta una mossa / flag made a move
108.         GOSUB MakeX ' fa la X       / if it maked X
109.         IF MadeAMove THEN ' se Š fatta la mossa    / if it made a move
110.             WhoWon = 1: GOSUB ComputeWin: IF WhoWon = 1 THEN RETURN
111.             'WhoWon flag per cercare il vincitore / WhoWon is flag to seek for winner
112.             t% = 0
113.             FOR i = 1 TO 9: t% = t% + zX(i): NEXT i
114.             IF t% = -5 THEN WhoWon = 0: RETURN
115.             ' se ci sono 5 X allora ci saranno 4 0 e sar… pari
116.             ' if there is 5 X then there shoude be 4 0s and it is tie
117.             MovesMade = MovesMade + 1 ' conta mosse/ it counts moves
118.             GOSUB MakeO
119.             WhoWon = 2: GOSUB ComputeWin: IF WhoWon = 2 THEN RETURN
120.             'WhoWon flag per cercare il vincitore / WhoWon is flag to seek for winner
121.         END IF
122.     END IF
123.     IF cC = "d" OR cC = CHR$(27) THEN WhoWon = 3 ' utente vuole uscire / users wants to exit
124.     IF WhoWon > 0 THEN RETURN ' se qualcuno vince ritorna al ciclo principale / if someone wins it returns to main loop
125. LOOP
126.  
127. MakeX:
128. GOSUB FindClickedPosition ' decodifica il click/ it decodes click
129. IF theBox = 0 THEN RETURN ' esce se non ha scelto / t exits if it doesn't choose
130. IF NOT zE(theBox) THEN RETURN ' esce se la cella non Š vuota/ it exits if cell is not void
131. xo theRow, theColumn, 1: ' Places an X
132. zX(theBox) = True: zE(theBox) = False ' aggiorna array X e Empty / it refreshes arrays X and Empty
133. MadeAMove = True ' flag fatta la mossa
134. RETURN
135.  
136. MakeO:
137. GOSUB FindPlaceForO ' modulo IA per 0/ modulo AI for 0
138. SLEEP 1: WHILE INKEY$ <> "": WEND ' aspetta 1 secondo/ it waits for 1 second
139. xo theRow, theColumn, 0: 'Places an 0  /mette uno 0
140. zO(theBox) = True: zE(theBox) = False ' imposta gli array / it sets arrays
141. RETURN
142.  
143. ComputeWin: ' PC usando 0 vince / PC using 0 wins
144. IF WhoWon = 1 THEN ' calcola se ha vinto la X/ it calculates if X wins
145.     IF XWin(1, 2, 3, 1) THEN RETURN
146.     IF XWin(4, 5, 6, 2) THEN RETURN
147.     IF XWin(7, 8, 9, 3) THEN RETURN
148.     IF XWin(1, 4, 7, 4) THEN RETURN
149.     IF XWin(2, 5, 8, 5) THEN RETURN
150.     IF XWin(3, 6, 9, 6) THEN RETURN
151.     IF XWin(1, 5, 9, 7) THEN RETURN
152.     IF XWin(3, 5, 7, 8) THEN RETURN
153. ELSE ' calcola se ha vinto lo 0/ it calculates if 0 wins
154.     IF OWin(1, 2, 3, 1) THEN RETURN
155.     IF OWin(4, 5, 6, 2) THEN RETURN
156.     IF OWin(7, 8, 9, 3) THEN RETURN
157.     IF OWin(1, 4, 7, 4) THEN RETURN
158.     IF OWin(2, 5, 8, 5) THEN RETURN
159.     IF OWin(3, 6, 9, 6) THEN RETURN
160.     IF OWin(1, 5, 9, 7) THEN RETURN
161.     IF OWin(3, 5, 7, 8) THEN RETURN
162. END IF
163. WhoWon = 0 ' nessuno vince/ nobody wins
164. RETURN
165.  
166. FindPlaceForO: ' qui c'Š il problema ovvero opera incompiuta / here is problem otherwise work unfinished
167. ' See if there is a win for O. If so, take it.
168. ' See if there is a threat of a win for X. If so, block it.
169. ' cerca se c'Š  una posizione che fa vincere 0 in tal caso la sceglie
170. ' cerca se c'Š una posizione che fa vincere X in tal caso le blocca
171. FOR TestType% = 1 TO 2
172.     theBox = 0 ' nessuna cella scelta /no cell choosen
173.     FOR theRow = 1 TO 3: FOR theColumn = 1 TO 3
174.             ' per tutte le righe e per tutte le colonne
175.             ' for all rows and all columns
176.             theBox = theBox + 1 ' aumenta il numero di cella /it increases number of cell
177.             IF zE(theBox) THEN ' se Š vuota / if it is void
178.                 tk$ = ""
179.                 SELECT CASE theBox ' sceglie le celle da controllare/ it chooses cells to control
180.                     CASE 1: tk$ = "234759"
181.                     CASE 2: tk$ = "1358"
182.                     CASE 3: tk$ = "126957"
183.                     CASE 4: tk$ = "1756"
184.                     CASE 5: tk$ = "19283746"
185.                     CASE 6: tk$ = "4539"
186.                     CASE 7: tk$ = "148935"
187.                     CASE 8: tk$ = "2579"
188.                     CASE 9: tk$ = "153678"
189.                 END SELECT
190.                 ' controlla le celle / it controls cells
191.                 FOR i = 1 TO LEN(tk$) STEP 2
192.                     j = VAL(MID$(tk$, i, 1))
193.                     k = VAL(MID$(tk$, i + 1, 1))
194.                     ' prende due celle successive / it takes two cells successive
195.                     IF TestType% = 1 THEN
196.                         ' cerca 2 celle con 0 se si, fa  tris / it seeks for 2 cells with 0 if yes it will make tris
197.                         IF zO(j) + zO(k) < -1 THEN RETURN
198.                     ELSE
199.                         ' cerca 2 celle con X se si blocca il tris di X / it searches 2 cells with X if yes it will block tris of X
200.                         IF zX(j) + zX(k) < -1 THEN RETURN
201.                     END IF
202.                 NEXT i
203.             END IF
204.     NEXT theColumn: NEXT theRow
205. NEXT TestType%
206. ' No move selected above to win or block win, so  / nessuna mossa per vincere o bloccare X quindi
207. IF Hard THEN ' modalit… difficile / hard mode
208.     IF MovesMade = 1 THEN ' fatta una sola mossa/ it has made one move
209.         IF zE(5) THEN ' se la cella centrale Š vuota la prende/ if central cell is empty it takes
210.             theRow = 2: theColumn = 2: theBox = 5
211.         ELSE
212.             IF RND > .5 THEN theRow = 1 ELSE theRow = 3 ' sceglie a caso riga superiore o inferiore/ it chooses at random upper row or lower row
213.             IF RND > .5 THEN theColumn = 1 ELSE theColumn = 3 ' sceglia a caso colonna 1 o 3/ it choosed at random column 1 or 3
214.             theBox = (3 * (theRow - 1)) + theColumn ' calcola uno degli angoli della griglia/ it calculates one of angles of grid
215.             ' anche qui TheRow e TheColumn sono intercambiabili
216.             ' also here TheRow e TheColumn are interchangeable
217.         END IF
218.         RETURN
219.     ELSEIF MovesMade = 2 THEN 'se X ha fatto 2 mosse / se X has made two moves
220.         IF zX(5) THEN ' se X sta al centro  / if X is at centre cell
221.             'se due angoli sono presi esamina gli altri due
222.             ' if 2 angles are taken it examines the other two  angles
223.             tk$ = ""
224.             IF zO(1) AND zX(9) THEN ' se angoli 1 e 9 sono presi/ if angles 1 and 9 are taken
225.                 tk$ = "37"
226.             ELSEIF zO(3) AND zX(7) THEN ' se angoli 3 e 7 sono presi/ if angles 3 and 7 are taken
227.                 tk$ = "19"
228.             ELSEIF zO(7) AND zX(3) THEN ' se angoli 3 e 7 sono presi/ if angles 3 and 7 are taken
229.                 tk$ = "19"
230.             ELSEIF zO(9) AND zX(1) THEN ' se angoli 1 e 9 sono presi/ if angles 1 and 9 are taken
231.                 tk$ = "37"
232.             END IF
233.             IF tk$ <> "" THEN 'se ci sono celle da esaminare/ if there are cells to examine
234.                 IF RND > .5 THEN
235.                     theBox = VAL(LEFT$(tk$, 1))
236.                 ELSE
237.                     theBox = VAL(LEFT$(tk$, 1))
238.                 END IF
239.                 ' sceglie a caso tra la prima cella della riga e la prima cella della riga???
240.                 'forse ci vuole RIGHT$ nell'ELSE
241.                 ' it chooses at random between first cell of row and first cell of row! ! ??
242.                 ' maybe here is right RIGHT$ in ELSE
243.  
244.                 theRow = (theBox + 2) \ 3 ' ottiene come risultato 1 o 3 / it gets as results 1 or 3
245.                 theColumn = theBox - (3 * (theRow - 1)) ' ottiene come risultato 1 o 3/ it gets as results 1 or 3
246.                 ' le celle da scegliere sono 1 (1,1) 3 (1,3) 7(3,1) 9(3,3) Cella(TheRow,TheColumn)
247.                 ' the  cells to choose are 1(1,1) 3 (1,3) 7 (3,1) 9 (3,3)  Cell(TheRow,TheColumn)
248.                 RETURN
249.             END IF
250.         ELSE
251.             'se la X non sta al centro / if X is not at centre
252.             escape% = 0 ' variabile per uscire dal loop infinito / variable to exit from infinite loop
253.             DO
254.                 DO:
255.                     theBox = 2 * FIX(1 + (RND * 4)):
256.                     ' genera a caso un numero da 1 a 10  /it makes a rnd_number from 1 to 10
257.                     ' il 10 capita all'incirca ogni 20 secondi e crea un errore in zE(TheBox)/ the 10 arrives about each 20 seconds and it makes error in zE(TheBox)
258.                     'cos ci vuole un controllo forte ad esempio un if TheBox = 10 then TheBox = MaxPossibleNotAngle (8)/so it need a strong control for example if TheBox = 10 then TheBox = MaxPossibleNotAngle (8)
259.  
260.                     ' codice di verifica/ degub code
261.                     ' LOCATE 28, 2: PRINT "theBox "; theBox, "zE(theBox) "; zE(theBox), "NOT zE(theBox) "; NOT zE(theBox)
262.  
263.                 LOOP WHILE NOT zE(theBox)
264.                 SELECT CASE theBox
265.                     CASE 2: IF NOT zX(8) THEN EXIT DO ELSE escape% = escape% + 1 'prende la casella 2 se la casella 8 Š  vuota/ it chooses cell 2 if cell 8 is empty
266.                     CASE 4: IF NOT zX(6) THEN EXIT DO ELSE escape% = escape% + 1 'prende la casella 4 se la casella 6 Š  vuota/ it chooses cell 4 if cell 6 is empty
267.                     CASE 6: IF NOT zX(4) THEN EXIT DO ELSE escape% = escape% + 1 'prende la casella 6 se la casella 4 Š  vuota/ it chooses cell 6 if cell 4 is empty
268.                     CASE 8: IF NOT zX(2) THEN EXIT DO ELSE escape% = escape% + 1 'prende la casella 8 se la casella 2 Š  vuota/ it chooses cell 8 if cell 2 is empty
269.                 END SELECT
270.                 ' 1 perchŠ non sceglie un angolo? / why doesn't it choose an angle?
271.                 '2 cosa fa se la casella opposta Š occupata?/ what does it, if the opposite cell is plenty?
272.                 ' qui manca del codice per uscire dal loop/ here there is no code to exit loop
273.                 IF (zX(2) AND zX(4) AND zO(5) AND zE(1)) THEN theBox = 1
274.                 IF (zX(2) AND zX(6) AND zO(5) AND zE(3)) THEN theBox = 3
275.                 IF (zX(4) AND zX(8) AND zO(5) AND zE(7)) THEN theBox = 7
276.                 IF (zX(6) AND zX(8) AND zO(5) AND zE(9)) THEN theBox = 9
277.  
278.             LOOP UNTIL (((theBox + 1) MOD 2) OR escape% = 16) '4 * 4 = 16 , in 16 loop tester… almeno una volta le 4 condizioni/ 4*4 = 16 in 16 loops it will test at least a time each of 4 conditions
279.             theRow = (theBox + 2) \ 3 ' calcola 1,2,2,3 rispettivamente a 2,4,6,8/ it calculates 1,2,2,3 for respectively 2,4,6,8
280.             theColumn = theBox - (3 * (theRow - 1)) ' calcola 2,1,3,2 seguendo i valori superiori/ it calculates 2,1,3,2 following the above values
281.             RETURN
282.         END IF
283.     END IF
284. END IF
285. ' OK, no good move was found. Make a random one
286. ' nessuna buona mossa da fare ne fa una a caso
287. DO: theBox = 1 + INT(RND * 9): LOOP WHILE NOT zE(theBox)
288. theRow = (theBox + 2) \ 3
289. theColumn = theBox - (3 * (theRow - 1))
290. RETURN
291.  
292. Shuffle:
293. DO WHILE LEN(w1$) < 4
294.     r% = 1 + INT(RND * 4)
295.     IF MID$(w2$, r%, 1) <> "x" THEN
296.         w1$ = w1$ + MID$(w2$, r%, 1)
297.         MID$(w2$, r%, 1) = "x"
298.     END IF
299. LOOP
300. RETURN
301.  
302. ShowWhoWon: ' mostra vincitore/ it shows winner
303. SELECT CASE WhoWon ' 4 casi Pari , Vinci, Perdi, Abbandoni / 4 cases Tie, win, lose, resigne
304.     CASE 0: c$ = "Tie! "
305.     CASE 1: c$ = "YOU WIN! "
306.     CASE 2: c$ = "YOU LOSE! "
307.     CASE 3: c$ = "YOU RESIGNED?"
308. END SELECT
309. IF WhoWon < 3 THEN SLEEP 2: WHILE INKEY$ <> "": WEND ' se non abbandona aspetta un tasto /if it doesn't resign , it waits a key
310. CLS
311. FOR i = 1 TO 30
312.     COLOR 1 + INT(RND * 15)
313.     LOCATE i, i + 20
314.     PRINT c$;
315. NEXT i
316. SLEEP 3: WHILE INKEY$ <> "": WEND ' aspetta almeno 3 secondi/ it waits at least 3 seconds
317. RETURN
318.  
319. InitializeScreen: ' crea la schermata iniziale del gioco / it creates initial screen game
320. CLS
321. COLOR 15
322. LOCATE 4, 23: PRINT "TIC TAC TOE by Paul Meyer & TheBOB"
323. LOCATE 7, 27: PRINT "(C) 2004 - 2007 Dos-Id Games"
324. LOCATE 5, 23: PRINT "Debugged and improved IA by TempodiBasic"
325. COLOR 3
326. ds% = 131: dd% = 97: dz% = 75 ' i 4 pulsanti / 4 buttons
327. LINE (ds%, 343)-(ds% + dz%, 380), , BF
328. LINE (ds% + (1 * dd%), 343)-(ds% + (1 * dd%) + dz%, 380), , BF
329. LINE (ds% + (2 * dd%), 343)-(ds% + (2 * dd%) + dz%, 380), , BF
330. LINE (ds% + (3 * dd%), 343)-(ds% + (3 * dd%) + dz%, 380), , BF
331. LOCATE 23, 19: PRINT " Easy "; ' 4 comandi per pulsanti / 4 command for buttons
332. LOCATE , 31: PRINT " Hard ";
333. LOCATE , 43: PRINT " Info ";
334. LOCATE , 55: PRINT " Quit "
335. RETURN
336.  
337. FindClickedCommand: ' da un significato al click / it gives a signify to click
338. Command = 0
339. SELECT CASE cV ' click in posizione verticale fuori oggetti / click in vertical position out of objects
340.     CASE IS < 343: RETURN
341.     CASE IS > 380: RETURN
342. END SELECT
343. SELECT CASE cH ' click in posizione orizzontale / click in horizontal position
344.     CASE IS < 130: RETURN ' area vuota / void area
345.     CASE IS < 205: Command = 1 ' tra 130 e 204 /between 130 and 204
346.     CASE IS < 227: RETURN ' area vuota / void area
347.     CASE IS < 303: Command = 2 'tra 227 e 302 / between 227 e 302
348.     CASE IS < 325: RETURN ' area vuota / void area
349.     CASE IS < 400: Command = 3 ' tra 325 e 399/ between 325 e 399
350.     CASE IS < 421: RETURN ' area vuota / void area
351.     CASE IS < 497: Command = 4 ' tra 421 e 496/ between 421 and 496
352. END SELECT
353. RETURN
354.  
355.  
356. DoHelp: ' subroutine vecchio stile con gosub_return/ soubroutine old style by gosub_return
357. ' mostra info / it shows info
358. CLS
359. COLOR 2
360. LOCATE 3, 1
361. PRINT "Credits"
362. PRINT "-------"
363. PRINT "This game was created by Paul Meyer in the year 2007."
364. PRINT: PRINT "Graphics by TheBob"
365. PRINT: PRINT "Improved mouse driver, modularity, machine play-to-win";
366. PRINT " by QBasic Mac"
367. PRINT " Debugging and improve IA by TempodiBasic"
368. PRINT: PRINT "History:"
369. PRINT "http://www.network54.com/Forum/190883/message/1175106480"
370. PRINT
371. PRINT "following QB64 package for years, debugged in 09 07 2016"
372. PRINT
373. PRINT "This is freeware, you may change this as much as you want"
374. PRINT "as long as you don't claim it as yours."
375. PRINT
376. PRINT
377. PRINT "About"
378. PRINT "-----"
379. PRINT "This is just a simple TIC TAC TOE game with mouse drivers."
380. PRINT "This game was created in QuickBasic."
381. CALL GetUserSignal 'aspetta un click o tasto premuto /it waits for a click o key_pressed
382. CLS
383. RETURN
384.  
385. SUB DrawSCREEN ' crea schermata gioco / it draws screen of game
386. DIM x AS INTEGER, y AS INTEGER
387. STATIC Finished AS INTEGER
388. CLS
389. ' scrive direttamente codice esadecimale alla RAM video
390. ' it writes directly Hex code into RAM of video
391. OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 18
392. OUT &H3C8, 4: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
393. OUT &H3C8, 9: OUT &H3C9, 0: OUT &H3C9, 12: OUT &H3C9, 48
394. OUT &H3C8, 11: OUT &H3C9, 0: OUT &H3C9, 18: OUT &H3C9, 54
395. COLOR 7: LOCATE 3, 31: PRINT "T I C - T A C - T O E"
396. LINE (170, 90)-(490, 410), 0, BF
397. LINE (160, 81)-(479, 399), 1, BF
398. LINE (155, 76)-(483, 404), 8, B
399. LINE (152, 73)-(487, 407), 8, B
400. LINE (160, 81)-(160, 399), 9
401. LINE (160, 81)-(479, 81), 9
402. LINE (371, 92)-(372, 393), 0, B
403. LINE (271, 92)-(272, 392), 0, B
404. LINE (171, 191)-(472, 192), 0, B
405. LINE (171, 291)-(472, 292), 0, B
406. LINE (369, 90)-(370, 390), 13, B
407. LINE (269, 90)-(270, 390), 13, B
408. LINE (169, 189)-(470, 190), 13, B
409. LINE (169, 289)-(470, 290), 13, B
410. LINE (5, 5)-(634, 474), 8, B
411. LINE (10, 10)-(629, 469), 8, B
412. IF Finished THEN EXIT SUB
413. Finished = True ' la prima volta imposta finished = vero  / first time it sets finished = true
414. ' e poi genera i simboli 0 e X e li mette in array per immagini alle posizioni 0 e 3000
415. ' and the it makes symbols 0 and X and it puts them in array for images at positions 0 and 3000
416. FOR x = 194 TO 500
417.     FOR y = 32 TO 46
418.         IF POINT(x, y) = 8 THEN PSET (x, y), 7
419.     NEXT y
420. NEXT x
421. PSET (188, 108), 0
422. DRAW "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P0,0"
423. PSET (186, 106), 10
424. DRAW "E3 F30 E30 F6 G30 F30 G6 H30 G30 H6 E30 H30 E3 BF2 P10,10"
425. CIRCLE (322, 141), 31, 0
426. CIRCLE (322, 141), 37, 0
427. PAINT STEP(0, 35), 0
428. PSET STEP(0, -35), 0
429. CIRCLE (320, 139), 31, 4
430. CIRCLE (320, 139), 37, 4
431. PAINT STEP(0, 35), 4
432. PSET STEP(0, -35), 1
433. GET STEP(-40, -40)-STEP(81, 81), SymbolBOX() ' mette 0 in posizione 0 / it puts 0 in position 0
434. GET (179, 98)-(260, 178), SymbolBOX(3000) 'mette X in posizione 3000 / it puts X in position 3000
435. xo 1, 1, 2: xo 1, 2, 2 ' cancella i simboli dalle celle / it cancels symbols from cells
436. END SUB
437.  
438. SUB EnableMouse (c%)
439. STATIC Status AS INTEGER ' variabile conservata / variable stored
440. ' status indica lo stato del mouse 0 spento 1 acceso       / status shows 0 mouse off 1 mouse on
441. ' c% Š la funzione da eseguire 0 spegnere 1 accendere 3 rilevare/ C% is function to act 0 turn off 3 detect
442. IF Status = 0 AND c% = 0 THEN EXIT SUB
443. STATIC Mx AS STRING 'variabile conservata/ variable stored
444. IF Mx = "" THEN 'inizializza Mx / it inizializes Mx
445.     m$ = "58E85080585080585080850815510C358508058508085080850815C00"
446.     n$ = "595BECB70BEAB70BE8BFBE6B7B8E7D33BEC978BEA97BE89FBE697DA80"
447.     Mx = SPACE$(57) ' Mx  Š di 57 bytes / Mx is of 57 bytes
448.     FOR i% = 1 TO 57
449.         ' virtuosismo che carica codici esadecimali in Mx suddivisi nelle due stringhe
450.         ' virtuosity it loads Hexadecimal codexes in Mx broke down them in two strings
451.         H$ = CHR$(VAL("&H" + MID$(m$, i%, 1) + MID$(n$, i%, 1)))
452.         MID$(Mx, i%, 1) = H$
453.     NEXT i%
454. END IF
455. IF c% = 0 THEN '  se deve spegnerlo/ if it must turn off
456.     'usa interrupt scritto in Mx per il mouse tramite call absolute
457.     ' it uses interrupt written in Mx for mouse by call absolute
458.     CALL ABSOLUTE(2, click, cH, cV, SADD(Mx))
459.     Status = 0
460.     EXIT SUB
461. END IF
462. ' se Š spento il mouse lo accende / if mouse is off, it turn on
463. 'usa interrupt scritto in Mx per il mouse tramite call absolute
464. ' it uses interrupt written in Mx for mouse by call  absolute
465. IF Status = 0 THEN CALL ABSOLUTE(1, click, cH, cV, SADD(Mx))
466. Status = 1
467. ' rileva il mouse/ it detects mouse
468. 'usa interrupt scritto in Mx per il mouse tramite call absolute
469. ' it uses interrupt written in Mx for mouse by call absolute
470. CALL ABSOLUTE(3, click, cH, cV, SADD(Mx))
471. ' la variabile click Š True se l'utente ha cliccato
472. 'variable click is True if user have made click
473. END SUB
474.  
475. ' prende input / get input
476. SUB GetUserSignal
477. DO
478.     IF 0 THEN ' Set to 1 for Debugging printout, otherwise 0
479.         LOCATE 2, 1
480.         PRINT click; "<Click"
481.         PRINT cH; "ch (Horizontal)"
482.         PRINT cV; "cv (Verticle)"
483.     END IF
484.     EnableMouse 1 ' attiva mouse  / it enables mouse
485.     IF click > 0 THEN
486.         ' se c'Š click la conservo in K% e aspetto che il tasto sia rilasciato
487.         ' if there is click I store it in k% and I wait until button is released
488.         k% = click
489.         WHILE click <> 0: EnableMouse 1: WEND
490.         click = k%
491.         EXIT DO ' esce dal loop esterno / it exits from outer loop
492.     END IF
493.     cC = INKEY$ ' utente pu•  uscire premendo un tasto / user can exit pressing a key
494. LOOP WHILE cC = ""
495. EnableMouse 0 ' spegne il mouse / it turns off mouse
496. END SUB
497.  
498. ' verifica se O ha vinto / it verifies if O won
499. FUNCTION OWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
500. IF zO(b1) = 0 OR zO(b2) = 0 OR zO(b3) = 0 THEN EXIT FUNCTION ' se una celle Š vuota esce / if one of these cells is void it exits
501. Winner l ' evidenzia graficamente il tris / it marks up graphically tris
502. OWin% = -1
503. END FUNCTION
504.  
505. SUB Winner (Lineup AS INTEGER) 'evidenzia il tris con una linea/ it shows tris by a line
506. SELECT CASE Lineup
507.     CASE 1: LINE (200, 140)-(440, 142), 14, BF: LINE (200, 143)-(440, 144), 0, B
508.     CASE 2: LINE (200, 240)-(440, 242), 14, BF: LINE (200, 243)-(440, 244), 0, B
509.     CASE 3: LINE (200, 340)-(440, 342), 14, BF: LINE (200, 343)-(440, 344), 0, B
510.     CASE 4: LINE (220, 120)-(222, 360), 14, BF: LINE (223, 120)-(223, 360), 0
511.     CASE 5: LINE (320, 120)-(322, 360), 14, BF: LINE (323, 120)-(323, 360), 0
512.     CASE 6: LINE (420, 120)-(422, 360), 14, BF: LINE (423, 120)-(423, 360), 0
513.     CASE 7: PSET (200, 120), 14: DRAW "F240 d H240 d F240 d H240 d C0 F240 d H240"
514.     CASE 8: PSET (440, 120), 14: DRAW "G240 d E240 d G240 d E240 d C0 G240 d E240"
515. END SELECT
516. END SUB
517.  
518. ' disegna la cella con simbolo se symbol Š 0 o 1 o la cella vuota se symbol Š 2
519. ' it draws cell with symbol if symbol is 0 or 1 or cell void if symbol is 2
520. SUB xo (Row AS INTEGER, Col AS INTEGER, symbol AS INTEGER)
521. DIM Index AS INTEGER, x AS INTEGER, y AS INTEGER
522. x = (Col - 1) * 100 + 180
523. y = (Row - 1) * 100 + 100
524. Index = symbol * 3000
525. IF Index < 6000 THEN
526.     PUT (x, y), SymbolBOX(Index), PSET
527. ELSE
528.     LINE (x, y)-(x + 80, y + 80), 1, BF
529. END IF
530. END SUB
531.  
532. 'verifica che X ha fatto tris / it verifies if X have got tris
533. FUNCTION XWin% (b1 AS INTEGER, b2 AS INTEGER, b3 AS INTEGER, l AS INTEGER)
534. IF zX(b1) = 0 OR zX(b2) = 0 OR zX(b3) = 0 THEN EXIT FUNCTION ' se una delle celle Š  vuota esce/ if one of these cells is voit it exits
535. Winner l ' evidenzia grafica del tris / it marks up graphically the tris
536. XWin% = -1
537. END FUNCTION
538.  
539.  

Title: Re: QBasic OS
Post by: EricE on March 30, 2020, 09:55:41 am

Thank you TempodiBasic.

Title: Re: QBasic OS
Post by: EricE on April 03, 2020, 01:25:04 am

The source code for the MMURTL V1.0 operating system is available for download.
A whole book in pdf form about MMURTL can also be downloaded.

http://www.ipdatacorp.com/mmurtl/ (http://www.ipdatacorp.com/mmurtl/)

Both OS and book are by the same author who wrote "Developing Your own 32 Bit Operating System" published in 1995.
There probably are some good ideas contained in both the book and source code.

Text Only | Text with Attachments