### Recent Posts

Pages: 1 [2] 3 4 ... 10
11
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by ZXDunny on 17. June 2018, 19:59:46 »
This one generates navigable mazes:

Code: [Select]
`10 mw=(scrw/8)-1,mh=(scrh/8)-1:    DIM map(mw,mh) BASE 020 m\$="1"*mw*mh,   b\$="1"*mw+(("1"+(" "*(mw-2))+"1")*(mh-2))+("1"*mw),   cc=mw+2:    DIM of=-1,-mw,1,mw:   m\$(cc)="0",stk\$=QCHR\$ cc:    DIM nb(4)30 nn=0:    FOR n=1 TO 4:       IF b\$(cc+of(n))<>"1" THEN          IF m\$(cc+(of(n)*2))<>"0" THEN    nn+=1:             nb(nn)=n40 NEXT n50 IF nn>0 THEN       o=of(nb(INT(RND*nn)+1)),       m\$(cc+o),m\$(cc+(o*2))="0",      stk\$=(QCHR\$(cc) AND nn>1)+stk\$:       cc+=o*2:       GO TO 3060 IF stk\$<>"" THEN       cc=QCODE stk\$,stk\$=stk\$(5 TO):       GO TO 3070 FOR n=0 TO LEN m\$-1:       map(n MOD mw,n DIV mw)=VAL m\$(n+1)*208:    NEXT n:    map(mw-1,mh-2)=080 for y=0 to mh-1:      for x=0 to mw-1:         print at y,x;"ð"(map(x,y)>0);:      next x:   next y`
12
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by B+ on 17. June 2018, 18:28:39 »
Yeah this one-liner (but not one statement) is not navigable for mouse looking for cheese... ie so that any spot can be reached from any other (you can always get there from here...)
Code: [Select]
`SCREEN _NEWIMAGE(560, 420, 32): _FONT 8: DO WHILE i < 80 * 60: _PRINTSTRING ((i MOD 80) * 7, INT(i / 80) * 7), CHR\$(45 * INT(RND * 2) + 47): i = i + 1: LOOP`
13
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by ZXDunny on 17. June 2018, 18:09:06 »
You want minimal maze-making code?
14
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by B+ on 17. June 2018, 15:03:52 »
If I remember correctly, NaaLaa is the master maze software to use.

Software? Maze making just takes a few lines of code. Could probably do it in less than 100. hmm... now I wonder what is minimal?
15
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by John on 16. June 2018, 22:17:27 »
If I remember correctly, NaaLaa is the master maze software to use.
16
##### Code and examples / Re: Rat Runner for Maze Maker
« Last post by B+ on 16. June 2018, 18:08:49 »
Here is the QB64 version of the the Amazing Rat with some more amusements added:
Code: [Select]
`_TITLE "Amazing rat B+ trans 2018-06-15"'from SmallBASIC to QB64 version 2017 1106/82 (the day before they switched to version 1.2)'2018-06-15 added more fun!'rat runs whole maze.bas for SmallBASIC 0.12.6 [B+MGA] 2016-06-30' mod of Chris maze gererator post' Backtracking maze generator' https://en.wikipedia.org/wiki/Maze_generation_algorithm'' - Starting from a random cell,' - Selects a random neighbouring cell that has not been visited.' - Remove the wall between the two cells and marks the new cell as visited,'   and adds it to the stack to facilitate backtracking.' - Continues with a cell that has no unvisited neighbours being considered a dead-end.'   When at a dead-end it backtracks through the path until it reaches a cell with an'   unvisited neighbour, continuing the path generation by visiting this new,'   unvisited cell (creating a new junction).'   This process continues until every cell has been visited, backtracking all the'   way back to the beginning cell. We can be sure every cell is visited.'' model constsCONST xmax = 1200CONST ymax = 700SCREEN _NEWIMAGE(xmax, ymax, 32)_SCREENMOVE 100, 20CONST W = 48CONST H = 28CONST margin = 25CONST border = margin / 2TYPE cell    x AS INTEGER    y AS INTEGEREND TYPEDIM SHARED cellWcellW = (xmax - margin) / WDIM SHARED cellHcellH = (ymax - margin) / HDIM SHARED h_walls(W, H)DIM SHARED v_walls(W, H)DIM SHARED pipi = _PI' What's a maze without a little white mouseRANDOMIZE TIMERinit_wallsgenerate_mazerX = 0: rY = 0: rd = 180DIM trail AS cellti = 0cheese = 0chx = INT(RND * (W - 1)) + 1chy = INT(RND * (H - 1)) + 1WHILE 1    'maze board    COLOR _RGB32(155, 75, 32)    recf 0, 0, xmax, ymax    show_maze    'add to trail    ti = ti + 1    REDIM _PRESERVE trail(ti) AS cell    trail(ti).x = border + (rX + .5) * cellW    trail(ti).y = border + (rY + .5) * cellH    'bread crumbs or whatever...    COLOR _RGBA(8, 4, 2, 40)    FOR i = 1 TO ti        fcirc trail(i).x, trail(i).y, 2    NEXT    'draw cheese    COLOR _RGB32(200, 180, 0)    fcirc border + (chx + .5) * cellW, border + (chy + .5) * cellH, .25 * cellH    'draw mouse    drawRat border + rX * cellW, border + rY * cellH, cellW, cellH, rd, cheese    'mouse find the cheese?    IF rX = chx AND rY = chy THEN        cheese = cheese + 1        chx = INT(RND * (W - 1)) + 1        chy = INT(RND * (H - 1)) + 1        ti = 0        REDIM trail(ti) AS cell        _DELAY 1    END IF    _DISPLAY    _DELAY .2    'setup next move    SELECT CASE rd        CASE 0            IF h_walls(rX, rY + 1) = 0 THEN                rY = rY + 1: rd = 90            ELSEIF v_walls(rX + 1, rY) = 0 THEN                rX = rX + 1            ELSEIF h_walls(rX, rY) = 0 THEN                rY = rY - 1: rd = 270            ELSE                rX = rX - 1: rd = 180            END IF        CASE 90            IF v_walls(rX, rY) = 0 THEN                rX = rX - 1: rd = 180            ELSEIF h_walls(rX, rY + 1) = 0 THEN                rY = rY + 1            ELSEIF v_walls(rX + 1, rY) = 0 THEN                rX = rX + 1: rd = 0            ELSE                rY = rY - 1: rd = 270            END IF        CASE 180            IF h_walls(rX, rY) = 0 THEN                rY = rY - 1: rd = 270            ELSEIF v_walls(rX, rY) = 0 THEN                rX = rX - 1            ELSEIF h_walls(rX, rY + 1) = 0 THEN                rY = rY + 1: rd = 90            ELSE                rX = rX + 1: rd = 0            END IF        CASE 270            IF v_walls(rX + 1, rY) = 0 THEN                rX = rX + 1: rd = 0            ELSEIF h_walls(rX, rY) = 0 THEN                rY = rY - 1            ELSEIF v_walls(rX, rY) = 0 THEN                rX = rX - 1: rd = 180            ELSE                rY = rY + 1: rd = 90            END IF    END SELECTWENDSUB init_walls ()    FOR x = 0 TO W        FOR y = 0 TO H            v_walls(x, y) = 1            h_walls(x, y) = 1        NEXT    NEXTEND SUBSUB show_maze ()    COLOR _RGB32(180, 90, 45)    'cls    py = border    FOR y = 0 TO H        px = border        FOR x = 0 TO W            IF x < W AND h_walls(x, y) = 1 THEN                recf px, py, px + cellW, py + 2            END IF            IF y < H AND v_walls(x, y) = 1 THEN                recf px, py, px + 2, py + cellH            END IF            px = px + cellW        NEXT        py = py + cellH    NEXTEND SUBSUB rand_cell (rWx, rHy)    rWx = INT(RND * 1000) MOD W    rHy = INT(RND * 1000) MOD HEND SUBSUB get_unvisited (visited(), current AS cell, unvisited() AS cell, uvi)    'local n    REDIM unvisited(0) AS cell    x = current.x    y = current.y    uvi = 0    IF x > 0 THEN        IF visited(x - 1, y) = 0 THEN            uvi = uvi + 1            REDIM _PRESERVE unvisited(uvi) AS cell            unvisited(uvi).x = x - 1            unvisited(uvi).y = y        END IF    END IF    IF x < W - 1 THEN        IF visited(x + 1, y) = 0 THEN            uvi = uvi + 1            REDIM _PRESERVE unvisited(uvi) AS cell            unvisited(uvi).x = x + 1            unvisited(uvi).y = y        END IF    END IF    IF y > 0 THEN        IF visited(x, y - 1) = 0 THEN            uvi = uvi + 1            REDIM _PRESERVE unvisited(uvi) AS cell            unvisited(uvi).x = x            unvisited(uvi).y = y - 1        END IF    END IF    IF y < H - 1 THEN        IF visited(x, y + 1) = 0 THEN            uvi = uvi + 1            REDIM _PRESERVE unvisited(uvi) AS cell            unvisited(uvi).x = x            unvisited(uvi).y = y + 1        END IF    END IFEND SUBSUB generate_maze ()    'local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells    'local x, y    DIM visited(W, H)    REDIM stack(0) AS cell    DIM curr_cell AS cell    DIM next_cell AS cell    rand_cell cur_cell.x, cur_cell.y    visited(curr_cell.x, curr_cell.y) = 1    num_visited = 1    num_cells = W * H    si = 0    WHILE num_visited < num_cells        REDIM cells(0) AS cell        cnt = 0        get_unvisited visited(), curr_cell, cells(), cnt        IF cnt > 0 THEN            ' choose randomly one of the current cell's unvisited neighbours            rc = INT(RND * 100) MOD cnt + 1            next_cell.x = cells(rc).x            next_cell.y = cells(rc).y            ' push the current cell to the stack            si = si + 1            REDIM _PRESERVE stack(si) AS cell            stack(si).x = curr_cell.x            stack(si).y = curr_cell.y            ' remove the wall between the current cell and the chosen cell            IF next_cell.x = curr_cell.x THEN                x = next_cell.x                y = max(next_cell.y, curr_cell.y)                h_walls(x, y) = 0            ELSE                x = max(next_cell.x, curr_cell.x)                y = next_cell.y                v_walls(x, y) = 0            END IF            ' make the chosen cell the current cell and mark it as visited            curr_cell.x = next_cell.x            curr_cell.y = next_cell.y            visited(curr_cell.x, curr_cell.y) = 1            num_visited = num_visited + 1        ELSEIF si > 0 THEN            ' pop a cell from the stack and make it the current cell            curr_cell.x = stack(si).x            curr_cell.y = stack(si).y            si = si - 1            REDIM _PRESERVE stack(si) AS cell        ELSE            EXIT WHILE        END IF    WENDEND SUBSUB drawRat (leftX, topY, cwidth, cheight, heading, cheese)    COLOR _RGB32(225, 225, 225)    'local bcX, bcY, bR, neckX, neckY    bcX = leftX + .5 * cwidth    bcY = topY + .5 * cheight    bR = .5 * .5 * min(cwidth, cheight)    'local noseX :    noseX = bcX + 2 * bR * COS(rad(heading))    'local noseY :    noseY = bcY + 2 * bR * SIN(rad(heading))    neckX = bcX + .75 * bR * COS(rad(heading))    neckY = bcY + .75 * bR * SIN(rad(heading))    'local tailX :    tailX = bcX + 2 * bR * COS(rad(heading + 180))    'local tailY :    tailY = bcY + 2 * bR * SIN(rad(heading + 180))    'local earLX :    earLX = bcX + bR * COS(rad(heading - 30))    'local earLY :    earLY = bcY + bR * SIN(rad(heading - 30))    'local earRX :    earRX = bcX + bR * COS(rad(heading + 30))    'local earRY :    earRY = bcY + bR * SIN(rad(heading + 30))    fcirc bcX, bcY, .65 * bR + 2 * cheese    fcirc neckX, neckY, bR * .3    ftri noseX, noseY, earLX, earLY, earRX, earRY, _RGB32(225, 225, 225)    fcirc earLX, earLY, bR * .3    fcirc earRX, earRY, bR * .3    wX = .7 * bR * COS(rad(heading - 90 - 20))    wY = .7 * bR * SIN(rad(heading - 90 - 20))    ln noseX + wX, noseY + wY, noseX - wX, noseY - wY    wX = .7 * bR * COS(rad(heading - 90 + 20))    wY = .7 * bR * SIN(rad(heading - 90 + 20))    ln noseX + wX, noseY + wY, noseX - wX, noseY - wY    ln bcX, bcY, tailX, tailYEND SUB'Steve McNeil's  copied from his forum   note: Radius is too common a nameSUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)    DIM subRadius AS LONG, RadiusError AS LONG    DIM X AS LONG, Y AS LONG    subRadius = ABS(R)    RadiusError = -subRadius    X = subRadius    Y = 0    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB    ' Draw the middle span here so we don't draw it twice in the main loop,    ' which would be a problem with blending turned on.    LINE (CX - X, CY)-(CX + X, CY), , BF    WHILE X > Y        RadiusError = RadiusError + Y * 2 + 1        IF RadiusError >= 0 THEN            IF X <> Y + 1 THEN                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF            END IF            X = X - 1            RadiusError = RadiusError - X * 2        END IF        Y = Y + 1        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF    WENDEND SUB' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)    a& = _NEWIMAGE(1, 1, 32)    _DEST a&    PSET (0, 0), K    _DEST 0    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)    _FREEIMAGE a& '<<< this is important!END SUBSUB ln (x1, y1, x2, y2)    LINE (x1, y1)-(x2, y2)END SUBSUB rec (x1, y1, x2, y2)    LINE (x1, y1)-(x2, y2), , BEND SUBSUB recf (x1, y1, x2, y2)    LINE (x1, y1)-(x2, y2), , BFEND SUBFUNCTION max (a, b)    IF a > b THEN max = a ELSE max = bEND FUNCTIONFUNCTION min (a, b)    IF a > b THEN min = b ELSE min = aEND FUNCTIONFUNCTION rad (a)    rad = a * pi / 180END FUNCTION`
Maybe John can get a JS version of it?

Here is a 12 x 7 maze screen shot when the rat has had a couple of hits of cheese:
17
##### Code and examples / Re: Tic Tac Toe
« Last post by John on 11. June 2018, 01:42:42 »
I think JavaScript in a web browser is a good match. Taking it to the server with Node is a joke.
18
##### Code and examples / Re: Tic Tac Toe
« Last post by John on 10. June 2018, 21:22:30 »
ScriptBASIC has a JavaScript (V7) extension module for Linux. The Windows version is buggy and not worth fixing.
19
##### Code and examples / Re: Tic Tac Toe
« Last post by B+ on 10. June 2018, 21:15:28 »
JavaScript in a browser can do some amazing things.

Sure! I can see why people are taking their Basic's and translating code to JS, like writing programs to compile in C or C++.
20
##### Code and examples / Re: Tic Tac Toe
« Last post by John on 10. June 2018, 21:11:05 »
JavaScript in a browser can do some amazing things.
Pages: 1 [2] 3 4 ... 10