Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 8 gosub 21
- 10 gosub 1407 : end
- 21 'ANSI Escape Sequences
- 22 E$ = chr$(27) \ Esc$ = E$ 'Escape char
- 23 SGR0$ = E$ + "[0m"'\ Modesoff$ = SGR0$ 'Turn off character attributes
- 24 SGR1$ = E$ + "[1m" \ Bold$ = SGR1$ 'Turn bold mode on
- 25 SGR2$ = E$ + "[2m" \ Lowint$ = SGR2$ 'Turn low intensity mode on
- 26 SGR4$ = E$ + "[4m" \ Underline$ = SGR4$ 'Turn underline mode on
- 27 SGR5$ = E$ + "[5m" \ Blink$ = SGR5$ 'Turn blinking mode on
- 28 SGR7$ = E$ + "[7m" \ Reverse$ = SGR7$ 'Turn reverse video on
- 29 SGR8$ = E$ + "[8m" \ Invisible$ = SGR8$ 'Turn invisible text mode on
- 30 SGR27$ = E$ + "[27m" 'Turn reverse video off
- 32 EL0$ = E$ + "" \ Cleareol$ = EL0$ 'Clear line from cursor right
- 33 EL1$ = E$ + "[1K" \ Clearbol$ = EL1$ 'Clear line from cursor left
- 34 EL2$ = E$ + "[2K" \ Clearline$ = EL2$ 'Clear entire line
- 35 ShowCursor$ = E$ + "[?25h" 'Show cursor
- 36 HideCursor$ = E$ + "[?25l" 'Hide cursor
- 37 Home$ = E$ + "[H" 'Move cursor to upper left corner
- 39 gosub 78
- 43 gosub 229
- 44 gosub 243
- 45 return
- 77 ' #COLOR# =======================================================================================================================
- 78 '
- 79 dim color$(1)
- 80 data 0, black, 1, red , 2, green, 3, yellow
- 81 data 4, blue , 5, magenta, 6, cyan , 7, white
- 82 color$("len") = str$(7)
- 83 for colorIdx% = 0 to color$("len")
- 84 read colorNum%, colorName$
- 85 color$(colorName$) = str$(colorNum%)
- 86 color$(colorNum%) = colorName$
- 87 next colorIdx%
- 88 def fnFgColor(aColor$) = E$ + "[38;5;" + color$(aColor$) + "m"
- 89 def fnBgColor(aColor$) = E$ + "[48;5;" + color$(aColor$) + "m"
- 90 return
- 91 ' ===============================================================================================================================
- 228 ' #MISC# ========================================================================================================================
- 229 '
- 230 def fnIf%(c%,x%,y%)=(c%<>0)*x%+(c%=0)*y%
- 231 def fnIf$(c%,x$,y$)=mid$(x$,1,(c%<>0)*len(x$))+mid$(y$,1,(c%=0)*len(y$))
- 232 def fnLocateCheck(y%,x%)=(y%>0)*(y%<=height)*(x%>0)*(x%<=width)
- 233 def fnLocate(y%,x%) = E$ + "[" + str$(y%) + ";" + str$(x%) + "H"
- 234 return
- 235 '
- 236 cls
- 237 cmdExec = 1 : return
- 243 '
- 244 dim aSplit$(1)
- 245 def fnAt$(s$,i%)=mid$(s$,i%,1)
- 246 def fnEndsWith(s$,t$)=(right$(s$,len(t$))=t$)+0
- 247 def fnStartsWith(s$,t$)=(left$(s$,len(t$))=t$)+0
- 248 def fnFirstWord$(s$)=mid$(s$, 1, instr(s$, " "))
- 249 def fnPadLeft$(c$,l%,p$)=string$(fnMax(l%-len(c$),0),fnIf$(len(p$)>0,fnAt$(p$,1)," "))+c$
- 250 def fnPad$(t$,l%)=fn_Pad$(t$,l%, l%/2, len(t$)/2, len(t$))
- 251 def fn_Pad$(t$,l%,m%,n%,o%)=spa(int(m%-n%))+t$+spa(l%-(int(m%-n%)+o%))
- 252 def fnRemLeft$(s$,n%)=right$(s$, len(s$) - n%)
- 253 def fnRemRight$(s$,n%)=left$(s$, len(s$) - n%)
- 254 '/**
- 255 ' * Replaces first occurrence of a substring of a string with a new substring.
- 256 ' * @param {string} t$ The base string from which to remove.
- 257 ' * @param {string} s$ The string to replace.
- 258 ' * @param {string} r$ The replacement string.
- 259 ' * @return {string} A copy of `t$` with `s$` replaced by
- 260 ' * `r$` or the original string if nothing is replaced.
- 261 ' * @temp p%= position, f%= found, g%= not found, l%= len text, m%= len search, n%= len replace
- 262 ' * @temp w%= len left, x%= len middle, y%= pos right, z%= len right
- 263 ' */
- 264 def fnReplace$(t$,s$,r$)=fn_Replace(t$,s$,r$,instr(t$,s$))
- 265 def fn_Replace(t$,s$,r$,p%)=fn__Replace(t$,r$,p%,p%>-1,p%=-1,len(t$),len(s$),len(r$))
- 266 def fn__Replace(t$,r$,p%,f%,g%,l%,m%,n%)=fn___Replace(t$,r$,f%*p%+g%*l%,f%*n%,f%*(1+p%+m%),f%*l%)
- 267 def fn___Replace(t$,r$,w%,x%,y%,z%)=mid$(t$,1,w%)+mid$(r$,1,x%)+mid$(t$,(y%<>0)*y%+(y%=0),z%)
- 268 return
- 346 '
- 347 iSplit% = 1 : iSplitArr% = 0
- 348 jSplit% = pos(pSplit$, pDelim$)
- 349 aSplit$(pArr$, "len") = "0"
- 350 if jSplit% = 0 then aSplit$(pArr$, iSplitArr%) = pSplit$ : return
- 351 delimLen% = len(pDelim$)
- 352 for wSplit% = 0 to 1 : wSplit% = 0
- 353 tSplit$ = mid$(pSplit$, iSplit%, jSplit% - iSplit%)
- 354 if fnStartsWith(tSplit$, pDelim$) then tSplit$ = fnRemLeft$(tSplit$, delimLen%) : aSplit$(pArr$, iSplitArr%) = "" : iSplitArr% = iSplitArr% + 1
- 355 aSplit$(pArr$, iSplitArr%) = tSplit$
- 356 iSplitArr% = iSplitArr% + 1
- 357 jSplit% = jSplit% + delimLen% : iSplit% = jSplit%
- 358 jSplit% = instr(pSplit$, pDelim$, jSplit%) + 1
- 359 if jSplit% = 0 then wSplit% = 1 : gosub 363
- 360 next wSplit%
- 361 aSplit$(pArr$, "len") = str$(iSplitArr%)
- 362 return
- 363 '
- 364 tSplit$ = mid$(pSplit$, iSplit%)
- 365 if fnStartsWith(tSplit$, pDelim$) then tSplit$ = fnRemLeft$(tSplit$, delimLen%) : aSplit$(pArr$, iSplitArr%) = "" : iSplitArr% = iSplitArr% + 1
- 366 aSplit$(pArr$, iSplitArr%) = tSplit$
- 367 return
- 401 '
- 402 r$ = "" : v = 0
- 403 for i = 1 to len(k$) : gosub 405 : next i : rleDecode$ = r$
- 404 return
- 405 '
- 406 i$ = fnAt$(k$, i)
- 407 if pos("0123456789", i$) then v = v * 10 + val(i$) : return
- 408 for m = 1 to v : r$ = r$ + i$ : next m : v = 0
- 409 return
- 563 ' #GOL# =========================================================================================================================
- 564 ' BASED ON MICHAEL ABRASH'S GRAPHICS PROGRAMMING BLACK BOOK CHAPTER 17
- 565 ' CELL STRUCTURE
- 566 '
- 567 ' Cells are stored in 8-bit chars where the 0th bit represents
- 568 ' the cell state and the 1st to 4th bit represent the number
- 569 ' of neighbours (up to 8). The 5th to 7th bits are unused.
- 570 ' Refer to this diagram: http://www.jagregory.com/abrash-black-book/images/17-03.jpg
- 571 '
- 572 ' CellMap stores an array of cells with their states
- 573 ' class CellMap
- 574 ' {
- 575 ' public:
- 576 ' CellMap(unsigned int w, unsigned int h);
- 577 ' ~CellMap();
- 578 ' void SetCell(unsigned int x, unsigned int y);
- 579 ' void ClearCell(unsigned int x, unsigned int y);
- 580 ' int CellState(int x, int y); // WHY NOT UNSIGNED?
- 581 ' void NextGen();
- 582 ' void Init();
- 583 ' private:
- 584 ' unsigned char* cells;
- 585 ' unsigned char* temp_cells;
- 586 ' unsigned int width;
- 587 ' unsigned int height;
- 588 ' unsigned int length_in_bytes;
- 589 ' };
- 590 'void DrawCell(unsigned int x, unsigned int y, unsigned int colour)
- 591 golDrawCell$ = golDrawCell$ + fnLocate(y%,x%) + golDrawText$
- 592 return
- 593 'int main(int argc, char* argv[])
- 594 ' Generation counter
- 595 generation% = 0
- 596 ' Initialise cell map
- 597 gosub 608
- 598 gosub 712
- 599 for wGol% = 0 to 1 : wGol% = 0
- 600 generation% = generation% + 1
- 601 golDrawCell$ = ""
- 602 ' Recalculate and draw next generation
- 603 gosub 679
- 604 print golDrawCell$+Home$+SGR0$+str$(generation%) : sleep 0
- 605 next wGol%
- 606 print ShowCursor$
- 607 cmdExec = 1: return
- 608 'CellMap::CellMap(unsigned int w, unsigned int h)
- 609 w% = width
- 610 h% = height
- 611 length_in_bytes% = w% * h%
- 612 dim cells%(length_in_bytes) 'cell storage
- 613 dim temp_cells%(length_in_bytes) 'temp cell storage
- 614 return
- 615 '
- 616 cn(x%,y%) = 1
- 617 if fnLocateCheck(y%, x%) then locate y%, x% : print fnFgColor(golColor$) + fnBgColor(golColor$) + "#" + SGR0$ : sleep 0
- 618 xm1% = (x%-1+X) mod X : xp1% = (x%+1+X) mod X
- 619 ym1% = (y%-1+Y) mod Y : yp1% = (y%+1+Y) mod Y
- 620 cells%(xm1%,y%) = cells%(xm1%,y%) + 1
- 621 cells%(xp1%,y%) = cells%(xp1%,y%) + 1
- 622 cells%(xm1%,ym1%) = cells%(xm1%,ym1%) + 1
- 623 cells%(x% ,ym1%) = cells%(x%,ym1%) + 1
- 624 cells%(xp1%,ym1%) = cells%(xp1%,ym1%) + 1
- 625 cells%(xm1%,yp1%) = cells%(xm1%,yp1%) + 1
- 626 cells%(x% ,yp1%) = cells%(x%,yp1%) + 1
- 627 cells%(xp1%,yp1%) = cells%(xp1%,yp1%) + 1
- 628 return
- 629 'void CellMap::SetCell(unsigned int x, unsigned int y)
- 630 'if fnLocateCheck(y%, x%) then locate y%, x% : print SGR0$ + " " : sleep 0
- 631 cell_ptr_c% = (y% * w%) + x%
- 632 'calculate the offsets to the eight neighboring cells,
- 633 'accounting for wrapping around at the edges of the cell map
- 634 xoleft% = fnIf%((x% = 0), w% -1, -1)
- 635 xoright% = fnIf%((x% = (w% - 1)), -1*(w% - 1), 1)
- 636 yoabove% = fnIf%((y% = 0), length_in_bytes% - w%, -1*w%)
- 637 yobelow% = fnIf%((y% = (h% - 1)),-1*(length_in_bytes% - w%), w%)
- 638 cellRaw% = cells%(cell_ptr_c%)
- 639 cells%(cell_ptr_c%) = cellRaw% or 1 'set first bit to 1
- 640 'change successive bits for neighbour counts
- 641 c_ptr_c_n% = cell_ptr_c%+yoabove%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 642 c_ptr_c_n% = cell_ptr_c%+yoabove% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 643 c_ptr_c_n% = cell_ptr_c%+yoabove%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 644 c_ptr_c_n% = cell_ptr_c%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 645 c_ptr_c_n% = cell_ptr_c%+xoright% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 646 c_ptr_c_n% = cell_ptr_c%+yobelow%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 647 c_ptr_c_n% = cell_ptr_c%+yobelow% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 648 c_ptr_c_n% = cell_ptr_c%+yobelow%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
- 649 golDrawText$ = fnBgColor(golColor$) + " " : gosub 590
- 650 return
- 651 'void CellMap::ClearCell(unsigned int x, unsigned int y)
- 652 'if fnLocateCheck(y%, x%) then locate y%, x% : print SGR0$ + " " : sleep 0
- 653 cell_ptr_c% = (y% * w%) + x%
- 654 'calculate the offsets to the eight neighboring cells,
- 655 'accounting for wrapping around at the edges of the cell map
- 656 xoleft% = fnIf%((x% = 0), w% -1, -1)
- 657 xoright% = fnIf%((x% = (w% - 1)), -1*(w% - 1), 1)
- 658 yoabove% = fnIf%((y% = 0), length_in_bytes% - w%, -1*w%)
- 659 yobelow% = fnIf%((y% = (h% - 1)),-1*(length_in_bytes% - w%), w%)
- 660 cellRaw% = cells%(cell_ptr_c%)
- 661 'cellState% = cellRaw% and 1
- 662 cells%(cell_ptr_c%) = cellRaw% - (cellRaw% and 1) 'set first bit to 0
- 663 'change successive bits for neighbour counts
- 664 c_ptr_c_n% = cell_ptr_c%+yoabove%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 665 c_ptr_c_n% = cell_ptr_c%+yoabove% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 666 c_ptr_c_n% = cell_ptr_c%+yoabove%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 667 c_ptr_c_n% = cell_ptr_c%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 668 c_ptr_c_n% = cell_ptr_c%+xoright% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 669 c_ptr_c_n% = cell_ptr_c%+yobelow%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 670 c_ptr_c_n% = cell_ptr_c%+yobelow% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 671 c_ptr_c_n% = cell_ptr_c%+yobelow%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
- 672 golDrawText$ = SGR0$ + " " : gosub 590
- 673 return
- 674 'int CellMap::CellState(int x, int y)
- 675 cell_ptr_cs% = (y% * w%) + x%
- 676 ' Return first bit (LSB: cell state stored here)
- 677 golCellState% = cells%(cell_ptr_cs%) and 1
- 678 return
- 679 'void CellMap::NextGen()
- 680 'print SGR0$+"CellMap::NextGen()"
- 681 ' Copy to temp map to keep an unaltered version
- 682 for cpyIdx% = 0 to length_in_bytes%
- 683 temp_cells%(cpyIdx%) = cells%(cpyIdx%)
- 684 next cpyIdx%
- 685 ' Process all cells in the current cell map
- 686 for y% = 0 to h% - 1
- 687 for x% = 0 to w% - 1
- 688 gosub 692 : sleep 0
- 689 next x%
- 690 next y%
- 691 return
- 692 '
- 693 cell_ptr% = (y% * w%) + x%
- 694 cellRaw% = temp_cells%(cell_ptr%)
- 695 ' Zero bytes are off and have no neighbours so skip them...
- 696 if cellRaw% = 0 then return
- 697 ' Remaining cells are either on or have neighbours
- 698 state% = cellRaw% and 1
- 699 count% = (cellRaw% - state%) / 2 ' # of neighboring on-cells
- 700 if state% = 1 then gosub 704 : return
- 701 if state% = 0 then gosub 708 : return
- 702 ' Advance to the next cell byte
- 703 return
- 704 '
- 705 ' On cell must turn off if not 2 or 3 neighbours
- 706 if (count% <> 2) and (count% <> 3) then gosub 651
- 707 return
- 708 '
- 709 ' Off cell must turn on if 3 neighbours
- 710 if count% = 3 then gosub 629
- 711 return
- 712 'void CellMap::Init()
- 713 golColor% = 1 : golColor$ = "white"
- 714 gosub 235 : print SGR0$
- 715 gosub 725
- 716 gosub 235 : print HideCursor$
- 717 XI = int((width/2)-(rleX%/2)) : YI = int((height/2)-(rleY%/2))
- 718 for yIdx% = 0 to aSplit$(pArr$, "len")
- 719 for xIdx% = 1 to len(aSplit$(pArr$, yIdx%))
- 720 cell$ = fnAt$(aSplit$(pArr$, yIdx%), xIdx%)
- 721 if cell$ = "o" then x% = XI+xIdx% : y% = YI+yIdx% : gosub 629
- 722 next xIdx%
- 723 next yIdx%
- 724 return
- 725 '
- 726 rle$ = ""
- 727 for wGolInput% = 0 to 1 : wGolInput% = 0
- 728 input "rle? ", inRle$
- 729 if fnStartsWith(inRle$, "#") = 0 and fnStartsWith(inRle$, "x") = 0 then rle$ = rle$ + inRle$
- 730 if fnStartsWith(inRle$, "x") then pSplit$ = inRle$
- 731 if fnEndsWith(inRle$, "!") or inRle$ = "" then wGolInput% = 1
- 732 next wGolInput%
- 733 pArr$ = "rleSize" : pDelim$ = " " : gosub 346
- 734 for golIdx% = 0 to aSplit$(pArr$, "len")
- 735 if aSplit$(pArr$, golIdx%) = "x" then rleX% = val(fnReplace$(aSplit$(pArr$, golIdx% + 2), ",", ""))
- 736 if aSplit$(pArr$, golIdx%) = "y" then rleY% = val(fnReplace$(aSplit$(pArr$, golIdx% + 2), ",", ""))
- 737 if aSplit$(pArr$, golIdx%) = "rule" then rleRule$ = aSplit$(pArr$, golIdx% + 2)
- 738 next golIdx%
- 739 print "x:";rleX% : print "y:";rleY% : print "rule:";rleRule$
- 740 'print : print rle$
- 741 k$ = rle$ : gosub 401
- 742 'print : print rleDecode$ : sleep 0
- 743 pArr$ = "rleDecode" : pSplit$ = rleDecode$ : pDelim$ = "$" : gosub 346
- 744 'gosub 378
- 745 print "press any key to start "; : golKey$ = inkey$
- 746 return
- 747 '
- 1407 '
- 1408 print "cmdTest"
- 1409 gosub 1412
- 1410 print "cmdTest complete"
- 1411 cmdExec = 1 : return
- 1412 '
- 1446 gosub 593
- 1448 return
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement