DECLARE SUB compgo2 (h%)\r
DECLARE SUB compgo (h%)\r
DECLARE SUB humngo (h%)\r
-DEFINT A-Z\r
+DefInt A-Z\r
\r
DECLARE SUB thinkc ()\r
DECLARE SUB thinkh ()\r
DECLARE SUB mklau ()\r
DECLARE SUB showr (x, y)\r
DECLARE SUB show ()\r
-DIM SHARED font(0 TO 7, 0 TO 7, 0 TO 255)\r
-DIM SHARED siz, fi, ri, rs\r
-DIM SHARED stri$\r
-DIM SHARED humx1, humy1, humx2, humy2\r
-DIM SHARED sug, smax\r
-DIM SHARED npos AS LONG\r
-DIM SHARED cx1, cy1, cx2, cy2\r
-\r
-siz = 6 ' Board size\r
+Dim Shared font(0 To 7, 0 To 7, 0 To 255)\r
+Dim Shared siz, fi, ri, rs\r
+Dim Shared stri$\r
+Dim Shared humx1, humy1, humx2, humy2\r
+Dim Shared sug, smax\r
+Dim Shared npos As Long\r
+Dim Shared cx1, cy1, cx2, cy2\r
+\r
+siz = 6 ' Board size\r
fi = 0\r
ri = 2\r
-smax = 3 ' thinking depth\r
+smax = 3 ' thinking depth\r
\r
\r
-DIM SHARED lau(-1 TO siz + 2, -1 TO siz + 2)\r
+Dim Shared lau(-1 To siz + 2, -1 To siz + 2)\r
\r
start\r
mklau\r
show\r
playg\r
\r
-SUB cmd (a$)\r
-\r
-mitus = 0\r
-DIM sona$(1 TO 10)\r
-FOR b = 1 TO 10\r
-sona$(b) = ""\r
-NEXT b\r
-\r
-d = 1\r
-e = 1\r
-FOR b = 1 TO LEN(a$)\r
-c$ = RIGHT$(LEFT$(a$, b), 1)\r
-IF c$ = " " THEN\r
-IF e = 0 THEN d = d + 1: e = 1\r
-GOTO 4\r
-END IF\r
-e = 0\r
-sona$(d) = sona$(d) + c$\r
-4\r
-NEXT b\r
-IF e = 1 THEN d = d - 1\r
-mitus = d\r
-\r
-\r
-SELECT CASE sona$(1)\r
-CASE "m"\r
-IF humx1 > 0 THEN msg "move replaced", 14\r
-\r
-humx1 = ASC(LEFT$(sona$(2), 1)) - 64\r
-IF humx1 > 32 THEN humx1 = humx1 - 32\r
-humy1 = VAL(RIGHT$(sona$(2), LEN(sona$(2)) - 1))\r
-humx2 = ASC(LEFT$(sona$(3), 1)) - 64\r
-IF humx2 > 32 THEN humx2 = humx2 - 32\r
-humy2 = VAL(RIGHT$(sona$(3), LEN(sona$(2)) - 1))\r
-\r
-CASE "h"\r
-msg "h - display help screen", 14\r
-msg "q - to quit", 14\r
-msg "m <from> <to> - make move", 14\r
-msg "n - no. positions processed", 14\r
-\r
-CASE "q"\r
-SYSTEM\r
-\r
-CASE "n"\r
-b$ = "positions processed:" + STR$(npos)\r
-msg b$, 14\r
-\r
-END SELECT\r
-\r
-END SUB\r
-\r
-SUB compgo (h)\r
-IF sug > smax THEN h = 0: GOTO 6\r
-sug = sug + 1\r
-npos = npos + 1\r
-freet\r
-IF sug = 1 THEN h1 = -2000 ELSE h1 = -1000\r
-\r
-'cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1\r
-b = 0\r
-c = 0\r
-m = 0\r
-FOR y = 1 TO siz ' check for eating\r
-FOR x = 1 TO siz\r
-IF lau(x, y) = 1 THEN\r
-8\r
-IF (lau(x - 1, y + 1) = 2) AND (lau(x - 2, y + 2) = 0) THEN\r
-SWAP lau(x, y), lau(x - 2, y + 2)\r
-lau(x - 1, y + 1) = 0\r
-compki m1, h2, x - 2, y + 2\r
-lau(x - 1, y + 1) = 2\r
-SWAP lau(x, y), lau(x - 2, y + 2)\r
-m1 = m1 + 1\r
-IF m1 > m THEN m = m1: h1 = -1000\r
-IF m1 = m THEN\r
-IF h2 + 1 > h1 THEN\r
-h1 = h2 + 1\r
-IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y + 2\r
-END IF\r
-END IF\r
-b = 1\r
-END IF\r
-\r
-\r
-IF (lau(x + 1, y + 1) = 2) AND (lau(x + 2, y + 2) = 0) THEN\r
-SWAP lau(x, y), lau(x + 2, y + 2)\r
-lau(x + 1, y + 1) = 0\r
-compki m1, h2, x + 2, y + 2\r
-lau(x + 1, y + 1) = 2\r
-SWAP lau(x, y), lau(x + 2, y + 2)\r
-m1 = m1 + 1\r
-IF m1 > m THEN m = m1: h1 = -1000\r
-IF m1 = m THEN\r
-IF h2 + 1 > h1 THEN\r
-h1 = h2 + 1\r
-IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y + 2\r
-END IF\r
-END IF\r
-b = 1\r
-END IF\r
-\r
-\r
-IF (lau(x - 1, y - 1) = 2) AND (lau(x - 2, y - 2) = 0) THEN\r
-SWAP lau(x, y), lau(x - 2, y - 2)\r
-lau(x - 1, y - 1) = 0\r
-compki m1, h2, x - 2, y - 2\r
-lau(x - 1, y - 1) = 2\r
-SWAP lau(x, y), lau(x - 2, y - 2)\r
-m1 = m1 + 1\r
-IF m1 > m THEN m = m1: h1 = -1000\r
-IF m1 = m THEN\r
-IF h2 + 1 > h1 THEN\r
-h1 = h2 + 1\r
-IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y - 2\r
-END IF\r
-END IF\r
-b = 1\r
-END IF\r
-\r
-\r
-IF (lau(x + 1, y - 1) = 2) AND (lau(x + 2, y - 2) = 0) THEN\r
-SWAP lau(x, y), lau(x + 2, y - 2)\r
-lau(x + 1, y - 1) = 0\r
-compki m1, h2, x + 2, y - 2\r
-lau(x + 1, y - 1) = 2\r
-SWAP lau(x, y), lau(x + 2, y - 2)\r
-m1 = m1 + 1\r
-IF m1 > m THEN m = m1: h1 = -1000\r
-IF m1 = m THEN\r
-IF h2 + 1 > h1 THEN\r
-h1 = h2 + 1\r
-IF npos = 1 THEN cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y - 2\r
-END IF\r
-END IF\r
-b = 1\r
-END IF\r
-\r
-\r
-\r
-\r
-\r
-IF c = 1 THEN GOTO 9\r
-END IF\r
-NEXT x\r
-NEXT y\r
-\r
-9\r
-IF (b = 1) AND (npos = 1) THEN\r
-cx3 = (cx1 + cx2) / 2\r
-cy3 = (cy1 + cy2) / 2\r
-lau(cx3, cy3) = 0\r
-showr cx3, cy3\r
-\r
-SWAP lau(cx1, cy1), lau(cx2, cy2)\r
-showr cx1, cy1\r
-showr cx2, cy2\r
-msg "NJAM!", 10\r
-x = cx2\r
-y = cy2\r
-c = 1\r
-b = 0\r
-GOTO 8\r
-END IF\r
-IF c = 1 THEN\r
-cx1 = 1: cy1 = 1: cx2 = 1: cy2 = 1\r
-GOTO 10\r
-END IF\r
-\r
-IF sug = 1 THEN\r
-msg "l��a ei saa", 4\r
-msg STR$(h1), 4\r
-END IF\r
-\r
-FOR y = 1 TO siz ' unuseful move\r
-FOR x = 1 TO siz\r
-IF lau(x, y) = 1 THEN\r
-IF lau(x - 1, y + 1) = 0 THEN\r
-SWAP lau(x, y), lau(x - 1, y + 1)\r
-humngo h2\r
-SWAP lau(x, y), lau(x - 1, y + 1)\r
-IF h2 > h1 THEN\r
-h1 = h2\r
-IF sug = 1 THEN cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1\r
-END IF\r
-END IF\r
-\r
-IF lau(x + 1, y + 1) = 0 THEN\r
-SWAP lau(x, y), lau(x + 1, y + 1)\r
-humngo h2\r
-SWAP lau(x, y), lau(x + 1, y + 1)\r
-IF h2 > h1 THEN\r
-h1 = h2\r
-IF sug = 1 THEN cx1 = x: cy1 = y: cx2 = x + 1: cy2 = y + 1\r
-END IF\r
-END IF\r
-\r
-END IF\r
-NEXT x\r
-NEXT y\r
-h = h1\r
-10\r
-sug = sug - 1\r
-6\r
-END SUB\r
-\r
-SUB compki (m, h, x1, y1)\r
-h1 = 0\r
-\r
-FOR y = 1 TO siz\r
-FOR x = 1 TO siz\r
-NEXT x\r
-NEXT y\r
-h = h1\r
-\r
-END SUB\r
-\r
-SUB freet\r
-a$ = INKEY$\r
-IF a$ = "" THEN\r
-ELSE\r
-IF a$ = CHR$(8) THEN\r
-IF LEN(stri$) > 0 THEN\r
-stri$ = LEFT$(stri$, LEN(stri$) - 1): GOTO 3\r
-END IF\r
-END IF\r
-IF a$ = CHR$(13) THEN\r
-IF LEN(stri$) > 0 THEN\r
-msg stri$, 7\r
-cmd stri$\r
-stri$ = ""\r
-END IF\r
-GOTO 3\r
-END IF\r
-stri$ = stri$ + a$\r
-3\r
-LINE (400, 468)-(639, 479), 1, BF\r
-prn 405, 469, 14, stri$\r
-END IF\r
-END SUB\r
-\r
-SUB getfnt\r
-SCREEN 13\r
-FOR a = 0 TO 255\r
-IF (a > 5) AND (a < 17) THEN GOTO 2\r
-LOCATE 1, 1\r
-PRINT CHR$(a)\r
-2\r
-FOR y = 0 TO 7\r
-FOR x = 0 TO 7\r
-font(x, y, a) = POINT(x, y)\r
-NEXT x\r
-NEXT y\r
-NEXT a\r
-\r
-END SUB\r
-\r
-SUB humngo (h)\r
-npos = npos + 1\r
-h1 = 1000\r
-\r
-FOR y = siz TO 1 STEP -1\r
-FOR x = siz TO 1 STEP -1\r
-IF lau(x, y) = 2 THEN\r
-IF lau(x - 1, y - 1) = 0 THEN\r
-SWAP lau(x, y), lau(x - 1, y - 1)\r
-compgo h2\r
-SWAP lau(x, y), lau(x - 1, y - 1)\r
-IF h2 < h1 THEN h1 = h2\r
-END IF\r
-\r
-IF lau(x + 1, y - 1) = 0 THEN\r
-SWAP lau(x, y), lau(x + 1, y - 1)\r
-compgo h2\r
-SWAP lau(x, y), lau(x + 1, y - 1)\r
-IF h2 < h1 THEN h1 = h2\r
-END IF\r
-\r
-\r
-IF (lau(x - 1, y - 1) = 1) AND (lau(x - 2, y - 2) = 0) THEN\r
-SWAP lau(x, y), lau(x - 2, y - 2)\r
-lau(x - 1, y - 1) = 0\r
-humngo h2\r
-lau(x - 1, y - 1) = 1\r
-SWAP lau(x, y), lau(x - 2, y - 2)\r
-IF h2 - 1 < h1 THEN h1 = h2 - 1\r
-END IF\r
-\r
-IF (lau(x + 1, y - 1) = 1) AND (lau(x + 2, y - 2) = 0) THEN\r
-SWAP lau(x, y), lau(x + 2, y - 2)\r
-lau(x + 1, y - 1) = 0\r
-humngo h2\r
-lau(x + 1, y - 1) = 1\r
-SWAP lau(x, y), lau(x + 2, y - 2)\r
-IF h2 - 1 < h1 THEN h1 = h2 - 1\r
-END IF\r
-\r
-\r
-\r
-\r
-END IF\r
-NEXT x\r
-NEXT y\r
-h = h1\r
-END SUB\r
-\r
-SUB mklau\r
-FOR y = -1 TO siz + 2\r
-FOR x = -1 TO siz + 2\r
-lau(x, y) = -1\r
-NEXT x\r
-NEXT y\r
-\r
-FOR y = 1 TO siz\r
-FOR x = 1 TO siz\r
-lau(x, y) = 0\r
-NEXT x\r
-NEXT y\r
-\r
-FOR y = 1 TO ri\r
-FOR x = 1 TO siz\r
-IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN\r
-lau(x, y) = 1\r
-END IF\r
-NEXT x\r
-NEXT y\r
-\r
-FOR y = siz - ri + 1 TO siz\r
-FOR x = 1 TO siz\r
-IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN\r
-lau(x, y) = 2\r
-END IF\r
-NEXT x\r
-NEXT y\r
-\r
-END SUB\r
-\r
-SUB msg (a$, c)\r
-DIM buf(1 TO 10000)\r
-FOR x = 400 TO 630 STEP 40\r
-GET (x, 8)-(x + 39, 467), buf(1)\r
-PUT (x, 0), buf(1), PSET\r
-NEXT x\r
-LINE (400, 460)-(639, 467), 0, BF\r
-prn 405, 460, c, a$\r
-END SUB\r
-\r
-SUB playg\r
-'GOTO 7\r
-1\r
-thinkc\r
-show\r
-7\r
-thinkh\r
-show\r
-GOTO 1\r
-\r
-\r
-END SUB\r
-\r
-SUB prn (x, y, c, a$)\r
-x1 = x\r
-y1 = y\r
-FOR a = 1 TO LEN(a$)\r
-b = ASC(RIGHT$(LEFT$(a$, a), 1))\r
-FOR y2 = 0 TO 7\r
-FOR x2 = 0 TO 7\r
-IF font(x2, y2, b) > 0 THEN PSET (x2 + x1, y2 + y1), c\r
-NEXT x2\r
-NEXT y2\r
-x1 = x1 + 8\r
-NEXT a\r
-END SUB\r
-\r
-SUB show\r
-FOR y = 1 TO siz\r
-FOR x = 1 TO siz\r
-showr x, y\r
-NEXT x\r
-NEXT y\r
-\r
-sp = rs / 2\r
-FOR x = 1 TO siz\r
-prn ((x - 1) * rs + 12 + sp), 2, 10, CHR$(64 + x)\r
-prn ((x - 1) * rs + 12 + sp), siz * rs + 11, 10, CHR$(64 + x)\r
-NEXT x\r
-\r
-FOR y = 1 TO siz\r
-a$ = STR$(y)\r
-a$ = RIGHT$(a$, LEN(a$) - 1)\r
-prn 15 - (LEN(a$) * 8), (y - 1) * rs + sp + 7, 10, a$\r
-prn (siz * rs + 16), (y - 1) * rs + sp + 7, 10, a$\r
-NEXT y\r
-\r
-\r
-END SUB\r
-\r
-SUB showr (x, y)\r
-IF (x + y + fi) / 2 = INT((x + y + fi) / 2) THEN c = 8 ELSE c = 7\r
-x1 = (x - 1) * rs + 15\r
-y1 = (y - 1) * rs + 10\r
-LINE (x1, y1)-(x1 + rs - 1, y1 + rs - 1), c, BF\r
-IF lau(x, y) > 0 THEN\r
-sp = rs / 2\r
-IF lau(x, y) = 1 THEN c1 = 15 ELSE c1 = 14\r
-CIRCLE (x1 + sp, y1 + sp), sp - 1, c1\r
-PAINT (x1 + sp, y1 + sp), c1\r
-END IF\r
-END SUB\r
-\r
-SUB start\r
-getfnt\r
-SCREEN 12\r
-LINE (399, 0)-(399, 479), 13\r
-msg "type 'h' for help", 14\r
-\r
-rs = INT(370 / siz)\r
-\r
-\r
-END SUB\r
-\r
-SUB thinkc\r
-msg "computer turn", 14\r
-sug = 0\r
-npos = 0\r
-cx1 = -1\r
-\r
-compgo h\r
-cmd "n"\r
-IF cx1 = -1 THEN msg "you won!", 10: msg "--------", 10: SYSTEM\r
-\r
-IF h <= -2 THEN msg "oh no...", 10\r
-IF h = -1 THEN msg "oops!", 10\r
-IF h = 1 THEN msg "yess! I will eat soon!", 10\r
-IF h >= 2 THEN msg "HA HA HA YOU ARE IN TROUBLE!", 10\r
-\r
-\r
-IF ABS(cx1 - cx2) = 2 THEN\r
-cx3 = (cx1 + cx2) / 2\r
-cy3 = (cy1 + cy2) / 2\r
-lau(cx3, cy3) = 0\r
-showr cx3, cy3\r
-END IF\r
-\r
-SWAP lau(cx1, cy1), lau(cx2, cy2)\r
-showr cx1, cy1\r
-showr cx2, cy2\r
-\r
-END SUB\r
-\r
-SUB thinkh\r
-msg "your turn", 14\r
-5\r
-freet\r
-IF humx1 = 0 THEN GOTO 5\r
-SWAP lau(humx2, humy2), lau(humx1, humy1)\r
-showr humx1, humy1\r
-showr humx2, humy2\r
-IF ABS(humx1 - humx2) = 2 THEN\r
-cx3 = (humx1 + humx2) / 2\r
-cy3 = (humy1 + humy2) / 2\r
-lau(cx3, cy3) = 0\r
-showr cx3, cy3\r
-END IF\r
-\r
-humx1 = 0\r
-END SUB\r
+Sub cmd (a$)\r
+\r
+ mitus = 0\r
+ Dim sona$(1 To 10)\r
+ For b = 1 To 10\r
+ sona$(b) = ""\r
+ Next b\r
+\r
+ d = 1\r
+ e = 1\r
+ For b = 1 To Len(a$)\r
+ c$ = Right$(Left$(a$, b), 1)\r
+ If c$ = " " Then\r
+ If e = 0 Then d = d + 1: e = 1\r
+ GoTo 4\r
+ End If\r
+ e = 0\r
+ sona$(d) = sona$(d) + c$\r
+ 4\r
+ Next b\r
+ If e = 1 Then d = d - 1\r
+ mitus = d\r
+\r
+\r
+ Select Case sona$(1)\r
+ Case "m"\r
+ If humx1 > 0 Then msg "move replaced", 14\r
+\r
+ humx1 = Asc(Left$(sona$(2), 1)) - 64\r
+ If humx1 > 32 Then humx1 = humx1 - 32\r
+ humy1 = Val(Right$(sona$(2), Len(sona$(2)) - 1))\r
+ humx2 = Asc(Left$(sona$(3), 1)) - 64\r
+ If humx2 > 32 Then humx2 = humx2 - 32\r
+ humy2 = Val(Right$(sona$(3), Len(sona$(2)) - 1))\r
+\r
+ Case "h"\r
+ msg "h - display help screen", 14\r
+ msg "q - to quit", 14\r
+ msg "m <from> <to> - make move", 14\r
+ msg "n - no. positions processed", 14\r
+\r
+ Case "q"\r
+ System\r
+\r
+ Case "n"\r
+ b$ = "positions processed:" + Str$(npos)\r
+ msg b$, 14\r
+\r
+ End Select\r
+\r
+End Sub\r
+\r
+Sub compgo (h)\r
+ If sug > smax Then h = 0: GoTo 6\r
+ sug = sug + 1\r
+ npos = npos + 1\r
+ freet\r
+ If sug = 1 Then h1 = -2000 Else h1 = -1000\r
+\r
+ 'cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1\r
+ b = 0\r
+ c = 0\r
+ m = 0\r
+ For y = 1 To siz ' check for eating\r
+ For x = 1 To siz\r
+ If lau(x, y) = 1 Then\r
+ 8\r
+ If (lau(x - 1, y + 1) = 2) And (lau(x - 2, y + 2) = 0) Then\r
+ Swap lau(x, y), lau(x - 2, y + 2)\r
+ lau(x - 1, y + 1) = 0\r
+ compki m1, h2, x - 2, y + 2\r
+ lau(x - 1, y + 1) = 2\r
+ Swap lau(x, y), lau(x - 2, y + 2)\r
+ m1 = m1 + 1\r
+ If m1 > m Then m = m1: h1 = -1000\r
+ If m1 = m Then\r
+ If h2 + 1 > h1 Then\r
+ h1 = h2 + 1\r
+ If npos = 1 Then cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y + 2\r
+ End If\r
+ End If\r
+ b = 1\r
+ End If\r
+\r
+\r
+ If (lau(x + 1, y + 1) = 2) And (lau(x + 2, y + 2) = 0) Then\r
+ Swap lau(x, y), lau(x + 2, y + 2)\r
+ lau(x + 1, y + 1) = 0\r
+ compki m1, h2, x + 2, y + 2\r
+ lau(x + 1, y + 1) = 2\r
+ Swap lau(x, y), lau(x + 2, y + 2)\r
+ m1 = m1 + 1\r
+ If m1 > m Then m = m1: h1 = -1000\r
+ If m1 = m Then\r
+ If h2 + 1 > h1 Then\r
+ h1 = h2 + 1\r
+ If npos = 1 Then cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y + 2\r
+ End If\r
+ End If\r
+ b = 1\r
+ End If\r
+\r
+\r
+ If (lau(x - 1, y - 1) = 2) And (lau(x - 2, y - 2) = 0) Then\r
+ Swap lau(x, y), lau(x - 2, y - 2)\r
+ lau(x - 1, y - 1) = 0\r
+ compki m1, h2, x - 2, y - 2\r
+ lau(x - 1, y - 1) = 2\r
+ Swap lau(x, y), lau(x - 2, y - 2)\r
+ m1 = m1 + 1\r
+ If m1 > m Then m = m1: h1 = -1000\r
+ If m1 = m Then\r
+ If h2 + 1 > h1 Then\r
+ h1 = h2 + 1\r
+ If npos = 1 Then cx1 = x: cy1 = y: cx2 = x - 2: cy2 = y - 2\r
+ End If\r
+ End If\r
+ b = 1\r
+ End If\r
+\r
+\r
+ If (lau(x + 1, y - 1) = 2) And (lau(x + 2, y - 2) = 0) Then\r
+ Swap lau(x, y), lau(x + 2, y - 2)\r
+ lau(x + 1, y - 1) = 0\r
+ compki m1, h2, x + 2, y - 2\r
+ lau(x + 1, y - 1) = 2\r
+ Swap lau(x, y), lau(x + 2, y - 2)\r
+ m1 = m1 + 1\r
+ If m1 > m Then m = m1: h1 = -1000\r
+ If m1 = m Then\r
+ If h2 + 1 > h1 Then\r
+ h1 = h2 + 1\r
+ If npos = 1 Then cx1 = x: cy1 = y: cx2 = x + 2: cy2 = y - 2\r
+ End If\r
+ End If\r
+ b = 1\r
+ End If\r
+\r
+\r
+\r
+\r
+\r
+ If c = 1 Then GoTo 9\r
+ End If\r
+ Next x\r
+ Next y\r
+\r
+ 9\r
+ If (b = 1) And (npos = 1) Then\r
+ cx3 = (cx1 + cx2) / 2\r
+ cy3 = (cy1 + cy2) / 2\r
+ lau(cx3, cy3) = 0\r
+ showr cx3, cy3\r
+\r
+ Swap lau(cx1, cy1), lau(cx2, cy2)\r
+ showr cx1, cy1\r
+ showr cx2, cy2\r
+ msg "NJAM!", 10\r
+ x = cx2\r
+ y = cy2\r
+ c = 1\r
+ b = 0\r
+ GoTo 8\r
+ End If\r
+ If c = 1 Then\r
+ cx1 = 1: cy1 = 1: cx2 = 1: cy2 = 1\r
+ GoTo 10\r
+ End If\r
+\r
+ If sug = 1 Then\r
+ msg "l��a ei saa", 4\r
+ msg Str$(h1), 4\r
+ End If\r
+\r
+ For y = 1 To siz ' unuseful move\r
+ For x = 1 To siz\r
+ If lau(x, y) = 1 Then\r
+ If lau(x - 1, y + 1) = 0 Then\r
+ Swap lau(x, y), lau(x - 1, y + 1)\r
+ humngo h2\r
+ Swap lau(x, y), lau(x - 1, y + 1)\r
+ If h2 > h1 Then\r
+ h1 = h2\r
+ If sug = 1 Then cx1 = x: cy1 = y: cx2 = x - 1: cy2 = y + 1\r
+ End If\r
+ End If\r
+\r
+ If lau(x + 1, y + 1) = 0 Then\r
+ Swap lau(x, y), lau(x + 1, y + 1)\r
+ humngo h2\r
+ Swap lau(x, y), lau(x + 1, y + 1)\r
+ If h2 > h1 Then\r
+ h1 = h2\r
+ If sug = 1 Then cx1 = x: cy1 = y: cx2 = x + 1: cy2 = y + 1\r
+ End If\r
+ End If\r
+\r
+ End If\r
+ Next x\r
+ Next y\r
+ h = h1\r
+ 10\r
+ sug = sug - 1\r
+ 6\r
+End Sub\r
+\r
+Sub compki (m, h, x1, y1)\r
+ h1 = 0\r
+\r
+ For y = 1 To siz\r
+ For x = 1 To siz\r
+ Next x\r
+ Next y\r
+ h = h1\r
+\r
+End Sub\r
+\r
+Sub freet\r
+ a$ = InKey$\r
+ If a$ = "" Then\r
+ Else\r
+ If a$ = Chr$(8) Then\r
+ If Len(stri$) > 0 Then\r
+ stri$ = Left$(stri$, Len(stri$) - 1): GoTo 3\r
+ End If\r
+ End If\r
+ If a$ = Chr$(13) Then\r
+ If Len(stri$) > 0 Then\r
+ msg stri$, 7\r
+ cmd stri$\r
+ stri$ = ""\r
+ End If\r
+ GoTo 3\r
+ End If\r
+ stri$ = stri$ + a$\r
+ 3\r
+ Line (400, 468)-(639, 479), 1, BF\r
+ prn 405, 469, 14, stri$\r
+ End If\r
+End Sub\r
+\r
+Sub getfnt\r
+ Screen 13\r
+ For a = 0 To 255\r
+ If (a > 5) And (a < 17) Then GoTo 2\r
+ Locate 1, 1\r
+ Print Chr$(a)\r
+ 2\r
+ For y = 0 To 7\r
+ For x = 0 To 7\r
+ font(x, y, a) = Point(x, y)\r
+ Next x\r
+ Next y\r
+ Next a\r
+\r
+End Sub\r
+\r
+Sub humngo (h)\r
+ npos = npos + 1\r
+ h1 = 1000\r
+\r
+ For y = siz To 1 Step -1\r
+ For x = siz To 1 Step -1\r
+ If lau(x, y) = 2 Then\r
+ If lau(x - 1, y - 1) = 0 Then\r
+ Swap lau(x, y), lau(x - 1, y - 1)\r
+ compgo h2\r
+ Swap lau(x, y), lau(x - 1, y - 1)\r
+ If h2 < h1 Then h1 = h2\r
+ End If\r
+\r
+ If lau(x + 1, y - 1) = 0 Then\r
+ Swap lau(x, y), lau(x + 1, y - 1)\r
+ compgo h2\r
+ Swap lau(x, y), lau(x + 1, y - 1)\r
+ If h2 < h1 Then h1 = h2\r
+ End If\r
+\r
+\r
+ If (lau(x - 1, y - 1) = 1) And (lau(x - 2, y - 2) = 0) Then\r
+ Swap lau(x, y), lau(x - 2, y - 2)\r
+ lau(x - 1, y - 1) = 0\r
+ humngo h2\r
+ lau(x - 1, y - 1) = 1\r
+ Swap lau(x, y), lau(x - 2, y - 2)\r
+ If h2 - 1 < h1 Then h1 = h2 - 1\r
+ End If\r
+\r
+ If (lau(x + 1, y - 1) = 1) And (lau(x + 2, y - 2) = 0) Then\r
+ Swap lau(x, y), lau(x + 2, y - 2)\r
+ lau(x + 1, y - 1) = 0\r
+ humngo h2\r
+ lau(x + 1, y - 1) = 1\r
+ Swap lau(x, y), lau(x + 2, y - 2)\r
+ If h2 - 1 < h1 Then h1 = h2 - 1\r
+ End If\r
+\r
+\r
+\r
+\r
+ End If\r
+ Next x\r
+ Next y\r
+ h = h1\r
+End Sub\r
+\r
+Sub mklau\r
+ For y = -1 To siz + 2\r
+ For x = -1 To siz + 2\r
+ lau(x, y) = -1\r
+ Next x\r
+ Next y\r
+\r
+ For y = 1 To siz\r
+ For x = 1 To siz\r
+ lau(x, y) = 0\r
+ Next x\r
+ Next y\r
+\r
+ For y = 1 To ri\r
+ For x = 1 To siz\r
+ If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then\r
+ lau(x, y) = 1\r
+ End If\r
+ Next x\r
+ Next y\r
+\r
+ For y = siz - ri + 1 To siz\r
+ For x = 1 To siz\r
+ If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then\r
+ lau(x, y) = 2\r
+ End If\r
+ Next x\r
+ Next y\r
+\r
+End Sub\r
+\r
+Sub msg (a$, c)\r
+ Dim buf(1 To 10000)\r
+ For x = 400 To 630 Step 40\r
+ Get (x, 8)-(x + 39, 467), buf(1)\r
+ Put (x, 0), buf(1), PSet\r
+ Next x\r
+ Line (400, 460)-(639, 467), 0, BF\r
+ prn 405, 460, c, a$\r
+End Sub\r
+\r
+Sub playg\r
+ 'GOTO 7\r
+ 1\r
+ thinkc\r
+ show\r
+ 7\r
+ thinkh\r
+ show\r
+ GoTo 1\r
+\r
+\r
+End Sub\r
+\r
+Sub prn (x, y, c, a$)\r
+ x1 = x\r
+ y1 = y\r
+ For a = 1 To Len(a$)\r
+ b = Asc(Right$(Left$(a$, a), 1))\r
+ For y2 = 0 To 7\r
+ For x2 = 0 To 7\r
+ If font(x2, y2, b) > 0 Then PSet (x2 + x1, y2 + y1), c\r
+ Next x2\r
+ Next y2\r
+ x1 = x1 + 8\r
+ Next a\r
+End Sub\r
+\r
+Sub show\r
+ For y = 1 To siz\r
+ For x = 1 To siz\r
+ showr x, y\r
+ Next x\r
+ Next y\r
+\r
+ sp = rs / 2\r
+ For x = 1 To siz\r
+ prn ((x - 1) * rs + 12 + sp), 2, 10, Chr$(64 + x)\r
+ prn ((x - 1) * rs + 12 + sp), siz * rs + 11, 10, Chr$(64 + x)\r
+ Next x\r
+\r
+ For y = 1 To siz\r
+ a$ = Str$(y)\r
+ a$ = Right$(a$, Len(a$) - 1)\r
+ prn 15 - (Len(a$) * 8), (y - 1) * rs + sp + 7, 10, a$\r
+ prn (siz * rs + 16), (y - 1) * rs + sp + 7, 10, a$\r
+ Next y\r
+\r
+\r
+End Sub\r
+\r
+Sub showr (x, y)\r
+ If (x + y + fi) / 2 = Int((x + y + fi) / 2) Then c = 8 Else c = 7\r
+ x1 = (x - 1) * rs + 15\r
+ y1 = (y - 1) * rs + 10\r
+ Line (x1, y1)-(x1 + rs - 1, y1 + rs - 1), c, BF\r
+ If lau(x, y) > 0 Then\r
+ sp = rs / 2\r
+ If lau(x, y) = 1 Then c1 = 15 Else c1 = 14\r
+ Circle (x1 + sp, y1 + sp), sp - 1, c1\r
+ Paint (x1 + sp, y1 + sp), c1\r
+ End If\r
+End Sub\r
+\r
+Sub start\r
+ getfnt\r
+ Screen 12\r
+ Line (399, 0)-(399, 479), 13\r
+ msg "type 'h' for help", 14\r
+\r
+ rs = Int(370 / siz)\r
+\r
+\r
+End Sub\r
+\r
+Sub thinkc\r
+ msg "computer turn", 14\r
+ sug = 0\r
+ npos = 0\r
+ cx1 = -1\r
+\r
+ compgo h\r
+ cmd "n"\r
+ If cx1 = -1 Then msg "you won!", 10: msg "--------", 10: System\r
+\r
+ If h <= -2 Then msg "oh no...", 10\r
+ If h = -1 Then msg "oops!", 10\r
+ If h = 1 Then msg "yess! I will eat soon!", 10\r
+ If h >= 2 Then msg "HA HA HA YOU ARE IN TROUBLE!", 10\r
+\r
+\r
+ If Abs(cx1 - cx2) = 2 Then\r
+ cx3 = (cx1 + cx2) / 2\r
+ cy3 = (cy1 + cy2) / 2\r
+ lau(cx3, cy3) = 0\r
+ showr cx3, cy3\r
+ End If\r
+\r
+ Swap lau(cx1, cy1), lau(cx2, cy2)\r
+ showr cx1, cy1\r
+ showr cx2, cy2\r
+\r
+End Sub\r
+\r
+Sub thinkh\r
+ msg "your turn", 14\r
+ 5\r
+ freet\r
+ If humx1 = 0 Then GoTo 5\r
+ Swap lau(humx2, humy2), lau(humx1, humy1)\r
+ showr humx1, humy1\r
+ showr humx2, humy2\r
+ If Abs(humx1 - humx2) = 2 Then\r
+ cx3 = (humx1 + humx2) / 2\r
+ cy3 = (humy1 + humy2) / 2\r
+ lau(cx3, cy3) = 0\r
+ showr cx3, cy3\r
+ End If\r
+\r
+ humx1 = 0\r
+End Sub\r
-' Svjatoslav Agejenko\r
-' Use keys:\r
-' Up, Down, Left, Right, w, z - rotate\r
-' <space> - speed down\r
-' q - quit\r
-\r
-DECLARE SUB getcor ()\r
-DECLARE SUB mulcor ()\r
-DECLARE SUB nait3d ()\r
-DECLARE SUB calcsin ()\r
-DefInt A-Z\r
-Dim Shared Xn(100), Yn(100), Zn(100)\r
-Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)\r
-Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)\r
-Dim Shared Cosine&(360), Sine&(360)\r
-Dim Shared np, nl\r
-Dim Shared jrp, jrl\r
-jrp = 0\r
-jrl = 0\r
-\r
-\r
-Screen 12\r
-Cls\r
-\r
-\r
-calcsin\r
-getcor\r
-mulcor\r
-nait3d\r
-\r
-\r
-\r
-\r
-Data 5,-60,-10\r
-Data 15,-50,-10\r
-Data 15,0,-10\r
-Data 5,10,-10\r
-Data -5,10,-10\r
-Data -15,0,-10\r
-Data -15,-50,-10\r
-Data -5,-60,-10\r
-\r
-Data 5,-60,10\r
-Data 15,-50,10\r
-Data 15,0,10\r
-Data 5,10,10\r
-Data -5,10,10\r
-Data -15,0,10\r
-Data -15,-50,10\r
-Data -5,-60,10\r
-\r
-Data 5,20,10\r
-Data 15,30,10\r
-Data 15,40,10\r
-Data 5,50,10\r
-Data -5,50,10\r
-Data -15,40,10\r
-Data -15,30,10\r
-Data -5,20,10\r
-\r
-Data 5,20,-10\r
-Data 15,30,-10\r
-Data 15,40,-10\r
-Data 5,50,-10\r
-Data -5,50,-10\r
-Data -15,40,-10\r
-Data -15,30,-10\r
-Data -5,20,-10\r
-\r
-Data 999,999,999\r
-\r
-Data 0,1\r
-Data 1,2\r
-Data 2,3\r
-Data 3,4\r
-Data 4,5\r
-Data 5,6\r
-Data 6,7\r
-Data 7,0\r
-\r
-Data 8,9\r
-Data 9,10\r
-Data 10,11\r
-Data 11,12\r
-Data 12,13\r
-Data 13,14\r
-Data 14,15\r
-Data 15,8\r
-\r
-\r
-Data 0,8\r
-Data 1,9\r
-Data 2,10\r
-Data 3,11\r
-Data 4,12\r
-Data 5,13\r
-Data 6,14\r
-Data 7,15\r
-\r
-Data 16,17\r
-Data 17,18\r
-Data 18,19\r
-Data 19,20\r
-Data 20,21\r
-Data 21,22\r
-Data 22,23\r
-Data 23,16\r
-\r
-\r
-Data 24,25\r
-Data 25,26\r
-Data 26,27\r
-Data 27,28\r
-Data 28,29\r
-Data 29,30\r
-Data 30,31\r
-Data 31,24\r
-\r
-Data 24,16\r
-Data 25,17\r
-Data 26,18\r
-Data 27,19\r
-Data 28,20\r
-Data 29,21\r
-Data 30,22\r
-Data 31,23\r
-\r
-Data 999,999\r
-\r
-Sub calcsin\r
- For a! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#\r
- Cosine&(a) = Int(.5 + Cos(a!) * 1024)\r
- Sine&(a) = Int(.5 + Sin(a!) * 1024)\r
- a = a + 1\r
- Next\r
-End Sub\r
-\r
-Sub getcor\r
- For a = 0 To 10000\r
- Read x(a), y(a), z(a)\r
- If x(a) = 999 Then x(a) = 0: y(a) = 0: z(a) = 0: GoTo 1\r
- Next\r
- 1\r
- np = a\r
-\r
- For a = 0 To 10000\r
- Read pointers1(a), pointers2(a)\r
- If pointers1(a) = 999 Then GoTo 2\r
- Next\r
- 2\r
- nl = a\r
-\r
-End Sub\r
-\r
-Sub mulcor\r
- suur = 0\r
- For a = 0 To np\r
- If Abs(x(a)) > suur Then suur = Abs(x(a))\r
- If Abs(y(a)) > suur Then suur = Abs(y(a))\r
- If Abs(z(a)) > suur Then suur = Abs(z(a))\r
- Next a\r
- ksuur = 100 / suur\r
-\r
- For a = 0 To np\r
- x(a) = x(a) * ksuur\r
- y(a) = y(a) * ksuur\r
- z(a) = z(a) * ksuur\r
- Next a\r
-End Sub\r
-\r
-Sub nait3d\r
-\r
- Do\r
-\r
- Deg1 = Deg1 + d1\r
- Deg2 = Deg2 + d2\r
- Deg3 = Deg3 + d3\r
-\r
- sound 0,1\r
-\r
- If Deg1 <= 0 Then Deg1 = Deg1 + 360\r
- If Deg2 <= 0 Then Deg2 = Deg2 + 360\r
- If Deg3 <= 0 Then Deg3 = Deg3 + 360\r
-\r
- If Deg1 >= 360 Then Deg1 = Deg1 - 360\r
- If Deg2 >= 360 Then Deg2 = Deg2 - 360\r
- If Deg3 >= 360 Then Deg3 = Deg3 - 360\r
-\r
- C1& = Cosine&(Deg1): S1& = Sine&(Deg1)\r
- C2& = Cosine&(Deg2): S2& = Sine&(Deg2)\r
- C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
-\r
- For a = 0 To np - 1\r
- R = a\r
- Xo = x(R): Yo = y(R): Zo = z(R)\r
-\r
- X1 = (Xo * C1& - Yo * S1&) \ 1024\r
- Y1 = (Xo * S1& + Yo * C1&) \ 1024\r
-\r
- X2& = (X1 * C2& - Zo * S2&) \ 1024\r
- z1 = (X1 * S2& + Zo * C2&) \ 1024\r
-\r
- Y2& = (Y1 * C3& - z1 * S3&) \ 1024\r
- z2 = (Y1 * S3& + z1 * C3&) \ 1024\r
-\r
- z2 = z2 + 300\r
- Xn(R) = 320 + (X2& / z2 * 500)\r
- Yn(R) = 240 + (Y2& / z2 * 500)\r
- Next\r
- \r
-\r
- For a1 = 0 To nl - 1\r
- F1 = pointers1(a1)\r
- S1 = pointers2(a1)\r
-\r
- Xn = Xn(F1)\r
- Yn = Yn(F1)\r
-\r
- X1 = Xn(S1)\r
- Y1 = Yn(S1)\r
-\r
- Line (Xs1(a1), Ys1(a1))-(Xe1(a1), Ye1(a1)), 0\r
- Line (X1, Y1)-(Xn, Yn), 15\r
-\r
-\r
- Xs1(a1) = X1: Ys1(a1) = Y1\r
- Xe1(a1) = Xn: Ye1(a1) = Yn\r
- Next\r
-\r
-\r
- K$ = InKey$\r
- If K$ <> "" Then\r
-\r
- Select Case K$\r
-\r
- Case Chr$(0) + Chr$(72)\r
- d1 = d1 + 1\r
-\r
- Case Chr$(0) + Chr$(80)\r
- d1 = d1 - 1\r
-\r
- Case Chr$(0) + Chr$(75)\r
- d2 = d2 - 1\r
-\r
- Case Chr$(0) + Chr$(77)\r
- d2 = d2 + 1\r
-\r
- Case "w"\r
- d3 = d3 - 1\r
-\r
- Case "z"\r
- d3 = d3 + 1\r
-\r
- Case " "\r
- d1 = d1 / 2\r
- d2 = d2 / 2\r
- d3 = d3 / 2\r
-\r
- Case Chr$(27)\r
- System\r
-\r
- End Select\r
- End If\r
-\r
- Loop\r
-End Sub\r
-\r
+' 3D Wireframe Exclamation mark
+' Author: Svjatoslav Agejenko
+' Use keys:
+' Up, Down, Left, Right, w, z - rotate
+' <space> - speed down
+' q - quit
+
+DECLARE SUB GetCoordinates ()
+DECLARE SUB ScaleCoordinates ()
+DECLARE SUB Render3D ()
+DECLARE SUB CalculateSineCosine ()
+
+DefInt A-Z
+Dim Shared Xn(100), Yn(100), Zn(100)
+Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)
+Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)
+Dim Shared Cosine&(360), Sine&(360)
+Dim Shared numPoints, numLines
+Dim Shared rotationX, rotationY
+rotationX = 0
+rotationY = 0
+
+Screen 12
+Cls
+CalculateSineCosine
+GetCoordinates
+ScaleCoordinates
+Render3D
+
+' Vertex data
+Data 5,-60,-10
+Data 15,-50,-10
+Data 15,0,-10
+Data 5,10,-10
+Data -5,10,-10
+Data -15,0,-10
+Data -15,-50,-10
+Data -5,-60,-10
+Data 5,-60,10
+Data 15,-50,10
+Data 15,0,10
+Data 5,10,10
+Data -5,10,10
+Data -15,0,10
+Data -15,-50,10
+Data -5,-60,10
+Data 5,20,10
+Data 15,30,10
+Data 15,40,10
+Data 5,50,10
+Data -5,50,10
+Data -15,40,10
+Data -15,30,10
+Data -5,20,10
+Data 5,20,-10
+Data 15,30,-10
+Data 15,40,-10
+Data 5,50,-10
+Data -5,50,-10
+Data -15,40,-10
+Data -15,30,-10
+Data -5,20,-10
+Data 999,999,999
+
+' Line data
+Data 0,1
+Data 1,2
+Data 2,3
+Data 3,4
+Data 4,5
+Data 5,6
+Data 6,7
+Data 7,0
+Data 8,9
+Data 9,10
+Data 10,11
+Data 11,12
+Data 12,13
+Data 13,14
+Data 14,15
+Data 15,8
+Data 0,8
+Data 1,9
+Data 2,10
+Data 3,11
+Data 4,12
+Data 5,13
+Data 6,14
+Data 7,15
+Data 16,17
+Data 17,18
+Data 18,19
+Data 19,20
+Data 20,21
+Data 21,22
+Data 22,23
+Data 23,16
+Data 24,25
+Data 25,26
+Data 26,27
+Data 27,28
+Data 28,29
+Data 29,30
+Data 30,31
+Data 31,24
+Data 24,16
+Data 25,17
+Data 26,18
+Data 27,19
+Data 28,20
+Data 29,21
+Data 30,22
+Data 31,23
+Data 999,999
+
+Sub CalculateSineCosine
+ ' Precalculate sine and cosine values for faster computation
+ For angle! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#
+ Cosine&(angle) = Int(.5 + Cos(angle!) * 1024)
+ Sine&(angle) = Int(.5 + Sin(angle!) * 1024)
+ angle = angle + 1
+ Next
+End Sub
+
+Sub GetCoordinates
+ ' Read vertex coordinates from DATA statements
+ For i = 0 To 10000
+ Read x(i), y(i), z(i)
+ If x(i) = 999 Then x(i) = 0: y(i) = 0: z(i) = 0: GoTo EndVertexData
+ Next
+ EndVertexData:
+ numPoints = i
+
+ ' Read line data from DATA statements
+ For i = 0 To 10000
+ Read pointers1(i), pointers2(i)
+ If pointers1(i) = 999 Then GoTo EndLineData
+ Next
+ EndLineData:
+ numLines = i
+End Sub
+
+Sub ScaleCoordinates
+ ' Scale coordinates to fit the screen
+ maxValue = 0
+ For i = 0 To numPoints
+ If Abs(x(i)) > maxValue Then maxValue = Abs(x(i))
+ If Abs(y(i)) > maxValue Then maxValue = Abs(y(i))
+ If Abs(z(i)) > maxValue Then maxValue = Abs(z(i))
+ Next i
+ scaleFactor = 100 / maxValue
+ For i = 0 To numPoints
+ x(i) = x(i) * scaleFactor
+ y(i) = y(i) * scaleFactor
+ z(i) = z(i) * scaleFactor
+ Next i
+End Sub
+
+Sub Render3D
+ Do
+ ' Update rotation angles
+ rotationX = rotationX + dx
+ rotationY = rotationY + dy
+ rotationZ = rotationZ + dz
+ Sound 0, 1
+
+ ' Wrap rotation angles within 0 to 359 degrees
+ If rotationX <= 0 Then rotationX = rotationX + 360
+ If rotationY <= 0 Then rotationY = rotationY + 360
+ If rotationZ <= 0 Then rotationZ = rotationZ + 360
+ If rotationX >= 360 Then rotationX = rotationX - 360
+ If rotationY >= 360 Then rotationY = rotationY - 360
+ If rotationZ >= 360 Then rotationZ = rotationZ - 360
+
+ ' Get sine and cosine values for rotation angles
+ cosX& = Cosine&(rotationX): sinX& = Sine&(rotationX)
+ cosY& = Cosine&(rotationY): sinY& = Sine&(rotationY)
+ cosZ& = Cosine&(rotationZ): sinZ& = Sine&(rotationZ)
+
+ ' Rotate and project vertices
+ For i = 0 To numPoints - 1
+ Xo = x(i): Yo = y(i): Zo = z(i)
+ X1 = (Xo * cosX& - Yo * sinX&) \ 1024
+ Y1 = (Xo * sinX& + Yo * cosX&) \ 1024
+ X2& = (X1 * cosY& - Zo * sinY&) \ 1024
+ Z1 = (X1 * sinY& + Zo * cosY&) \ 1024
+ Y2& = (Y1 * cosZ& - Z1 * sinZ&) \ 1024
+ Z2 = (Y1 * sinZ& + Z1 * cosZ&) \ 1024
+ Z2 = Z2 + 300
+ Xn(i) = 320 + (X2& / Z2 * 500)
+ Yn(i) = 240 + (Y2& / Z2 * 500)
+ Next
+
+ ' Draw lines between vertices
+ For i = 0 To numLines - 1
+ startVertex = pointers1(i)
+ endVertex = pointers2(i)
+ Xn = Xn(startVertex)
+ Yn = Yn(startVertex)
+ X1 = Xn(endVertex)
+ Y1 = Yn(endVertex)
+ Line (Xs1(i), Ys1(i))-(Xe1(i), Ye1(i)), 0
+ Line (X1, Y1)-(Xn, Yn), 15
+ Xs1(i) = X1: Ys1(i) = Y1
+ Xe1(i) = Xn: Ye1(i) = Yn
+ Next
+
+ ' Handle user input
+ K$ = InKey$
+ If K$ <> "" Then
+ Select Case K$
+ Case Chr$(0) + Chr$(72) ' Up arrow
+ dx = dx + 1
+ Case Chr$(0) + Chr$(80) ' Down arrow
+ dx = dx - 1
+ Case Chr$(0) + Chr$(75) ' Left arrow
+ dy = dy - 1
+ Case Chr$(0) + Chr$(77) ' Right arrow
+ dy = dy + 1
+ Case "w"
+ dz = dz - 1
+ Case "z"
+ dz = dz + 1
+ Case " " ' Space bar
+ dx = dx / 2
+ dy = dy / 2
+ dz = dz / 2
+ Case Chr$(27) ' Escape key
+ System
+ End Select
+ End If
+ Loop
+End Sub
\ No newline at end of file
-' 3D starfield\r
-' made by Svjatoslav Agejenko\r
-' in 2003.03\r
-' H-Page: svjatoslav.eu\r
-' E-Mail: svjatoslav@svjatoslav.eu\r
-\r
-DECLARE SUB setstar (x2!, y2!, z2!)\r
-DECLARE SUB galaxy ()\r
-DIM SHARED mitu\r
-DIM SHARED mituv\r
-\r
-\r
-RANDOMIZE TIMER\r
-mituv = 2000\r
-mitu = mituv\r
-rns = 500\r
-wl = 0\r
-\r
-DIM SHARED px(1 TO mitu + 1000)\r
-DIM SHARED py(1 TO mitu + 1000)\r
-DIM SHARED pz(1 TO mitu + 1000)\r
-\r
-FOR a = 1 TO mitu\r
-pz(a) = RND * 500 + 20\r
- n = RND * 100\r
- px(a) = SIN(n) * 20\r
- py(a) = COS(n) * 20\r
-NEXT a\r
-\r
-\r
-SCREEN 13\r
-\r
-\r
-frm = 10\r
-1\r
-fps = fps + 1\r
-IF tm$ <> TIME$ THEN\r
-'LOCATE 1, 1\r
-'PRINT fps\r
-IF fps > 20 THEN wl = wl + 2 ELSE wl = wl - 1\r
-IF wl < 0 THEN wl = 0\r
-fps = 0\r
-tm$ = TIME$\r
-END IF\r
-frm = frm + 1\r
-xp = SIN(frm / 21) * 3\r
-yp = SIN(frm / 18) * 3\r
-\r
-nrk = (3.1412) / 2 + SIN(frm / 35) / 100 + SIN(frm / 21) / 100\r
-rs1 = SIN(nrk)\r
-rc1 = COS(nrk)\r
-\r
-FOR a = 1 TO mitu\r
-x = px(a)\r
-y = py(a)\r
-z = pz(a)\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-PSET (x1, y1), 0\r
-\r
-x5 = x * rs1 - y * rc1\r
-y5 = x * rc1 + y * rs1\r
-\r
-x = x5\r
-y = y5\r
-\r
-z = z - 3\r
-x = x + xp\r
-y = y + yp\r
-IF z < 10 THEN\r
-z = RND * 300 + 400\r
-x = RND * 800 - 400\r
-y = RND * 800 - 400\r
-END IF\r
-\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-c = 3000 / z + 15\r
-IF c > 31 THEN c = 31\r
-PSET (x1, y1), c\r
-\r
-px(a) = x\r
-py(a) = y\r
-pz(a) = z\r
-NEXT a\r
-\r
-\r
-IF mituv - mitu > rns THEN galaxy: rns = RND * 800 + 100\r
-\r
-FOR a = 1 TO 2\r
-b = RND * (mitu - 10) + 1\r
-SWAP px(mitu), px(b)\r
-SWAP py(mitu), py(b)\r
-SWAP pz(mitu), pz(b)\r
-\r
-x = px(mitu)\r
-y = py(mitu)\r
-z = pz(mitu)\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-PSET (x1, y1), 0\r
-mitu = mitu - 1\r
-NEXT a\r
-\r
-'LOCATE 2, 1\r
-'PRINT wl\r
-FOR a = 0 TO wl\r
-FOR b = 0 TO 1000\r
-c = c / 100\r
-NEXT b\r
-NEXT a\r
-\r
-IF INKEY$ <> "" THEN SYSTEM\r
-GOTO 1\r
-\r
-SUB galaxy\r
-\r
-xf = RND * 4 - 2\r
-yf = RND * 4 - 2\r
-xp = RND * 200 - 100\r
-yp = RND * 200 - 100\r
-\r
-FOR a = 1 TO RND * 15 + 10 STEP .04\r
-x = SIN(a) * a * a / 10\r
-y = COS(a) * a * a / 10\r
-setstar x + RND * a * a / 30 + xp, y + RND * a * a / 30 + yp, 700 + RND * a * a / 30 + (x * xf) + (y * yf)\r
-NEXT a\r
-\r
-'SOUND 1000, 1\r
-END SUB\r
-\r
-SUB setstar (x2, y2, z2)\r
-mitu = mitu + 1\r
-s = mitu\r
-\r
-px(s) = x2\r
-py(s) = y2\r
-pz(s) = z2\r
-END SUB\r
+' 3D Starfield Simulation\r
+' Originally made by Svjatoslav Agejenko in 2003.03\r
+' In 2024 code was modernized using artificial intelligence\r
+' Homepage: svjatoslav.eu\r
+' Email: svjatoslav@svjatoslav.eu\r
+\r
+DECLARE SUB AddStar (xPosition AS SINGLE, yPosition AS SINGLE, zPosition AS SINGLE)\r
+DECLARE SUB CreateGalaxy ()\r
+\r
+Dim Shared totalStars As Integer\r
+Dim Shared maxStars As Integer\r
+\r
+Randomize Timer\r
+maxStars = 2000\r
+totalStars = maxStars\r
+starFieldDepth = 500\r
+\r
+Dim Shared starXPositions(1 To maxStars + 1000) As Single\r
+Dim Shared starYPositions(1 To maxStars + 1000) As Single\r
+Dim Shared starZPositions(1 To maxStars + 1000) As Single\r
+\r
+' Initialize the positions of the stars\r
+For starIndex = 1 To totalStars\r
+ starZPositions(starIndex) = Rnd * starFieldDepth + 20\r
+ angle = Rnd * 100\r
+ starXPositions(starIndex) = Sin(angle) * 20\r
+ starYPositions(starIndex) = Cos(angle) * 20\r
+Next starIndex\r
+\r
+Screen 13\r
+\r
+\r
+Do\r
+\r
+ ' Calculate the camera's rotation and position offsets\r
+ frameCount = frameCount + 1\r
+ cameraRotation = (3.1412 / 2) + Sin(frameCount / 35) / 100 + Sin(frameCount / 21) / 100\r
+ rs1 = Sin(cameraRotation)\r
+ rc1 = Cos(cameraRotation)\r
+\r
+ ' Update and draw each star\r
+ For starIndex = 1 To totalStars\r
+ x = starXPositions(starIndex)\r
+ y = starYPositions(starIndex)\r
+ z = starZPositions(starIndex)\r
+\r
+ ' Project the star's 3D position onto the 2D screen\r
+ projectedX = (x / z) * 160 + 160\r
+ projectedY = (y / z) * 100 + 100\r
+ PSet (projectedX, projectedY), 0 ' Erase the previous position\r
+\r
+ ' Rotate the star's position around the camera\r
+ x5 = x * rs1 - y * rc1\r
+ y5 = x * rc1 + y * rs1\r
+\r
+ ' Update the star's position with camera movement\r
+ x = x5 + Sin(frameCount / 21) * 3\r
+ y = y5 + Sin(frameCount / 18) * 3\r
+\r
+ ' Move the star closer to the viewer and wrap around if too close\r
+ z = z - 3\r
+ If z < 10 Then\r
+ z = Rnd * 300 + 400\r
+ x = Rnd * 800 - 400\r
+ y = Rnd * 800 - 400\r
+ End If\r
+\r
+ ' Project the new position and draw with perspective-based brightness\r
+ projectedX = (x / z) * 160 + 160\r
+ projectedY = (y / z) * 100 + 100\r
+ colorCode = 3000 / z + 15\r
+ If colorCode > 31 Then colorCode = 31\r
+ PSet (projectedX, projectedY), colorCode\r
+\r
+ ' Update the star's array positions\r
+ starXPositions(starIndex) = x\r
+ starYPositions(starIndex) = y\r
+ starZPositions(starIndex) = z\r
+ Next starIndex\r
+\r
+ ' Add new stars to the galaxy if needed\r
+ If maxStars - totalStars > Rnd * 800 + 100 Then CreateGalaxy: totalStars = totalStars + 1\r
+\r
+ ' Remove the two farthest stars and replace them with new ones\r
+ For a = 1 To 2\r
+ starIndex = Int(Rnd * (totalStars - 10)) + 1\r
+ Swap starXPositions(totalStars), starXPositions(starIndex)\r
+ Swap starYPositions(totalStars), starYPositions(starIndex)\r
+ Swap starZPositions(totalStars), starZPositions(starIndex)\r
+\r
+ x = starXPositions(totalStars)\r
+ y = starYPositions(totalStars)\r
+ z = starZPositions(totalStars)\r
+ projectedX = (x / z) * 160 + 160\r
+ projectedY = (y / z) * 100 + 100\r
+ PSet (projectedX, projectedY), 0 ' Erase the star\r
+ totalStars = totalStars - 1\r
+ Next a\r
+\r
+\r
+ ' Check for user input to exit the program\r
+ If InKey$ <> "" Then System\r
+\r
+ ' sleep, to limit framerate\r
+ Sound 0, 1\r
+Loop\r
+\r
+' Subroutine to create a new galaxy of stars\r
+Sub CreateGalaxy\r
+ xForce = Rnd * 4 - 2\r
+ yForce = Rnd * 4 - 2\r
+ xPositionOffset = Rnd * 200 - 100\r
+ yPositionOffset = Rnd * 200 - 100\r
+\r
+ ' Add a new set of stars with varying positions and velocities\r
+ For starIndex = 1 To Int(Rnd * 15) + 10 Step .04\r
+ x = Sin(starIndex) * starIndex * starIndex / 10\r
+ y = Cos(starIndex) * starIndex * starIndex / 10\r
+ AddStar x + RND * starIndex * starIndex / 30 + xPositionOffset, _\r
+ y + RND * starIndex * starIndex / 30 + yPositionOffset, _\r
+ 700 + RND * starIndex * starIndex / 30 + (x * xForce) + (y * yForce)\r
+ Next starIndex\r
+\r
+ ' Play a sound when creating new stars (commented out)\r
+ ' SOUND 1000, 1\r
+End Sub\r
+\r
+' Subroutine to add a new star at the specified position\r
+Sub AddStar (xPosition As Single, yPosition As Single, zPosition As Single)\r
+ totalStars = totalStars + 1\r
+ starIndex = totalStars\r
+\r
+ starXPositions(starIndex) = xPosition\r
+ starYPositions(starIndex) = yPosition\r
+ starZPositions(starIndex) = zPosition\r
+End Sub\r
\r
projects / qbasicapps.git / commitdiff