API tools faq
paste
Advertisement
Searinox

gol

Searinox
Aug 2nd, 2020
3,080
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
MapBasic 14.15 KB | None | 0 0
raw download clone embed print report
  1.     8  gosub 21
  2.    10  gosub 1407 : end
  3.    21  'ANSI Escape Sequences
  4.    22  E$     = chr$(27)   \ Esc$       = E$    'Escape char
  5.    23  SGR0$  = E$ + "[0m"'\ Modesoff$  = SGR0$ 'Turn off character attributes
  6.    24  SGR1$  = E$ + "[1m" \ Bold$      = SGR1$ 'Turn bold mode on
  7.    25  SGR2$  = E$ + "[2m" \ Lowint$    = SGR2$ 'Turn low intensity mode on
  8.    26  SGR4$  = E$ + "[4m" \ Underline$ = SGR4$ 'Turn underline mode on
  9.    27  SGR5$  = E$ + "[5m" \ Blink$     = SGR5$ 'Turn blinking mode on
  10.    28  SGR7$  = E$ + "[7m" \ Reverse$   = SGR7$ 'Turn reverse video on
  11.    29  SGR8$  = E$ + "[8m" \ Invisible$ = SGR8$ 'Turn invisible text mode on
  12.    30  SGR27$ = E$ + "[27m"                     'Turn reverse video off
  13.    32  EL0$   = E$ + "" \ Cleareol$  = EL0$  'Clear line from cursor right
  14.    33  EL1$   = E$ + "[1K" \ Clearbol$  = EL1$  'Clear line from cursor left
  15.    34  EL2$   = E$ + "[2K" \ Clearline$ = EL2$  'Clear entire line
  16.    35  ShowCursor$ = E$ + "[?25h"           'Show cursor
  17.    36  HideCursor$ = E$ + "[?25l"           'Hide cursor
  18.    37  Home$ =       E$ + "[H"              'Move cursor to upper left corner
  19.    39  gosub 78
  20.    43  gosub 229
  21.    44  gosub 243
  22.    45  return
  23.    77  ' #COLOR# =======================================================================================================================
  24.    78  '
  25.    79  dim color$(1)
  26.    80  data 0, black, 1, red    , 2, green, 3, yellow
  27.    81  data 4, blue , 5, magenta, 6, cyan , 7, white
  28.    82  color$("len") = str$(7)
  29.    83  for colorIdx% = 0 to color$("len")
  30.    84  read colorNum%, colorName$
  31.    85  color$(colorName$) = str$(colorNum%)
  32.    86  color$(colorNum%) = colorName$
  33.    87  next colorIdx%
  34.    88  def fnFgColor(aColor$) = E$ + "[38;5;" + color$(aColor$) + "m"
  35.    89  def fnBgColor(aColor$) = E$ + "[48;5;" + color$(aColor$) + "m"
  36.    90  return
  37.    91  ' ===============================================================================================================================
  38.   228  ' #MISC# ========================================================================================================================
  39.   229  '
  40.   230  def fnIf%(c%,x%,y%)=(c%<>0)*x%+(c%=0)*y%
  41.   231  def fnIf$(c%,x$,y$)=mid$(x$,1,(c%<>0)*len(x$))+mid$(y$,1,(c%=0)*len(y$))
  42.   232  def fnLocateCheck(y%,x%)=(y%>0)*(y%<=height)*(x%>0)*(x%<=width)
  43.   233  def fnLocate(y%,x%) = E$ + "[" + str$(y%) + ";" + str$(x%) + "H"
  44.   234  return
  45.   235  '
  46.   236  cls
  47.   237  cmdExec = 1 : return
  48.   243  '
  49.   244  dim aSplit$(1)
  50.   245  def fnAt$(s$,i%)=mid$(s$,i%,1)
  51.   246  def fnEndsWith(s$,t$)=(right$(s$,len(t$))=t$)+0
  52.   247  def fnStartsWith(s$,t$)=(left$(s$,len(t$))=t$)+0
  53.   248  def fnFirstWord$(s$)=mid$(s$, 1, instr(s$, " "))
  54.   249  def fnPadLeft$(c$,l%,p$)=string$(fnMax(l%-len(c$),0),fnIf$(len(p$)>0,fnAt$(p$,1)," "))+c$
  55.   250  def fnPad$(t$,l%)=fn_Pad$(t$,l%, l%/2, len(t$)/2, len(t$))
  56.   251  def fn_Pad$(t$,l%,m%,n%,o%)=spa(int(m%-n%))+t$+spa(l%-(int(m%-n%)+o%))
  57.   252  def fnRemLeft$(s$,n%)=right$(s$, len(s$) - n%)
  58.   253  def fnRemRight$(s$,n%)=left$(s$, len(s$) - n%)
  59.   254  '/**
  60.   255  ' *  Replaces first occurrence of a substring of a string with a new substring.
  61.   256  ' *  @param {string} t$ The base string from which to remove.
  62.   257  ' *  @param {string} s$ The string to replace.
  63.   258  ' *  @param {string} r$ The replacement string.
  64.   259  ' *  @return {string} A copy of `t$` with `s$` replaced by
  65.   260  ' *      `r$` or the original string if nothing is replaced.
  66.   261  ' *  @temp p%= position, f%= found, g%= not found, l%= len text, m%= len search, n%= len replace
  67.   262  ' *  @temp w%= len left, x%= len middle, y%= pos right, z%= len right
  68.   263  ' */
  69.   264  def fnReplace$(t$,s$,r$)=fn_Replace(t$,s$,r$,instr(t$,s$))
  70.   265  def fn_Replace(t$,s$,r$,p%)=fn__Replace(t$,r$,p%,p%>-1,p%=-1,len(t$),len(s$),len(r$))
  71.   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%)
  72.   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%)
  73.   268  return
  74.   346  '
  75.   347  iSplit% = 1 : iSplitArr% = 0
  76.   348  jSplit% = pos(pSplit$, pDelim$)
  77.   349  aSplit$(pArr$, "len") = "0"
  78.   350  if jSplit% = 0 then aSplit$(pArr$, iSplitArr%) = pSplit$ : return
  79.   351  delimLen% = len(pDelim$)
  80.   352  for wSplit% = 0 to 1 : wSplit% = 0
  81.   353  tSplit$ = mid$(pSplit$, iSplit%, jSplit% - iSplit%)
  82.   354  if fnStartsWith(tSplit$, pDelim$) then tSplit$ = fnRemLeft$(tSplit$, delimLen%) : aSplit$(pArr$, iSplitArr%) = "" : iSplitArr% = iSplitArr% + 1
  83.   355  aSplit$(pArr$, iSplitArr%) = tSplit$
  84.   356  iSplitArr% = iSplitArr% + 1
  85.   357  jSplit% = jSplit% + delimLen% : iSplit% = jSplit%
  86.   358  jSplit% = instr(pSplit$, pDelim$, jSplit%) + 1
  87.   359  if jSplit% = 0 then wSplit% = 1 : gosub 363
  88.   360  next wSplit%
  89.   361  aSplit$(pArr$, "len") = str$(iSplitArr%)
  90.   362  return
  91.   363  '
  92.   364  tSplit$ = mid$(pSplit$, iSplit%)
  93.   365  if fnStartsWith(tSplit$, pDelim$) then tSplit$ = fnRemLeft$(tSplit$, delimLen%) : aSplit$(pArr$, iSplitArr%) = "" : iSplitArr% = iSplitArr% + 1
  94.   366  aSplit$(pArr$, iSplitArr%) = tSplit$
  95.   367  return
  96.   401  '
  97.   402  r$ = "" : v = 0
  98.   403  for i = 1 to len(k$) : gosub 405 : next i : rleDecode$ = r$
  99.   404  return
  100.   405  '
  101.   406  i$ = fnAt$(k$, i)
  102.   407  if pos("0123456789", i$) then v = v * 10 + val(i$) : return
  103.   408  for m = 1 to v : r$ = r$ + i$ : next m : v = 0
  104.   409  return
  105.   563  ' #GOL# =========================================================================================================================
  106.   564  ' BASED ON MICHAEL ABRASH'S GRAPHICS PROGRAMMING BLACK BOOK CHAPTER 17
  107.   565  ' CELL STRUCTURE
  108.   566  '
  109.   567  ' Cells are stored in 8-bit chars where the 0th bit represents
  110.   568  ' the cell state and the 1st to 4th bit represent the number
  111.   569  ' of neighbours (up to 8). The 5th to 7th bits are unused.
  112.   570  ' Refer to this diagram: http://www.jagregory.com/abrash-black-book/images/17-03.jpg
  113.   571  '
  114.   572  ' CellMap stores an array of cells with their states
  115.   573  ' class CellMap
  116.   574  ' {
  117.   575  ' public:
  118.   576  '   CellMap(unsigned int w, unsigned int h);
  119.   577  '   ~CellMap();
  120.   578  '   void SetCell(unsigned int x, unsigned int y);
  121.   579  '   void ClearCell(unsigned int x, unsigned int y);
  122.   580  '   int CellState(int x, int y); // WHY NOT UNSIGNED?
  123.   581  '   void NextGen();
  124.   582  '   void Init();
  125.   583  ' private:
  126.   584  '   unsigned char* cells;
  127.   585  '   unsigned char* temp_cells;
  128.   586  '   unsigned int width;
  129.   587  '   unsigned int height;
  130.   588  '   unsigned int length_in_bytes;
  131.   589  ' };
  132.   590  'void DrawCell(unsigned int x, unsigned int y, unsigned int colour)
  133.   591  golDrawCell$ = golDrawCell$ + fnLocate(y%,x%) + golDrawText$
  134.   592  return
  135.   593  'int main(int argc, char* argv[])
  136.   594  ' Generation counter
  137.   595  generation% = 0
  138.   596  ' Initialise cell map
  139.   597  gosub 608
  140.   598  gosub 712
  141.   599  for wGol% = 0 to 1 : wGol% = 0
  142.   600  generation% = generation% + 1
  143.   601  golDrawCell$ = ""
  144.   602  ' Recalculate and draw next generation
  145.   603  gosub 679
  146.   604  print golDrawCell$+Home$+SGR0$+str$(generation%) : sleep 0
  147.   605  next wGol%
  148.   606  print ShowCursor$
  149.   607  cmdExec = 1: return
  150.   608  'CellMap::CellMap(unsigned int w, unsigned int h)
  151.   609  w% = width
  152.   610  h% = height
  153.   611  length_in_bytes% = w% * h%
  154.   612  dim cells%(length_in_bytes) 'cell storage
  155.   613  dim temp_cells%(length_in_bytes) 'temp cell storage
  156.   614  return
  157.   615  '
  158.   616  cn(x%,y%) = 1
  159.   617  if fnLocateCheck(y%, x%) then locate y%, x% : print fnFgColor(golColor$) + fnBgColor(golColor$) + "#" + SGR0$ : sleep 0
  160.   618  xm1% = (x%-1+X) mod X : xp1% = (x%+1+X) mod X
  161.   619  ym1% = (y%-1+Y) mod Y : yp1% = (y%+1+Y) mod Y
  162.   620  cells%(xm1%,y%)   = cells%(xm1%,y%)   + 1
  163.   621  cells%(xp1%,y%)   = cells%(xp1%,y%)   + 1
  164.   622  cells%(xm1%,ym1%) = cells%(xm1%,ym1%) + 1
  165.   623  cells%(x%  ,ym1%) = cells%(x%,ym1%)   + 1
  166.   624  cells%(xp1%,ym1%) = cells%(xp1%,ym1%) + 1
  167.   625  cells%(xm1%,yp1%) = cells%(xm1%,yp1%) + 1
  168.   626  cells%(x%  ,yp1%) = cells%(x%,yp1%)   + 1
  169.   627  cells%(xp1%,yp1%) = cells%(xp1%,yp1%) + 1
  170.   628  return
  171.   629  'void CellMap::SetCell(unsigned int x, unsigned int y)
  172.   630  'if fnLocateCheck(y%, x%) then locate y%, x% : print SGR0$ + " " : sleep 0
  173.   631  cell_ptr_c% = (y% * w%) + x%
  174.   632  'calculate the offsets to the eight neighboring cells,
  175.   633  'accounting for wrapping around at the edges of the cell map
  176.   634  xoleft%  = fnIf%((x% = 0), w% -1, -1)
  177.   635  xoright% = fnIf%((x% = (w% - 1)), -1*(w% - 1), 1)
  178.   636  yoabove% = fnIf%((y% = 0), length_in_bytes% - w%, -1*w%)
  179.   637  yobelow% = fnIf%((y% = (h% - 1)),-1*(length_in_bytes% - w%), w%)
  180.   638  cellRaw% = cells%(cell_ptr_c%)
  181.   639  cells%(cell_ptr_c%) = cellRaw% or 1 'set first bit to 1
  182.   640  'change successive bits for neighbour counts
  183.   641  c_ptr_c_n% = cell_ptr_c%+yoabove%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  184.   642  c_ptr_c_n% = cell_ptr_c%+yoabove%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  185.   643  c_ptr_c_n% = cell_ptr_c%+yoabove%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  186.   644  c_ptr_c_n% = cell_ptr_c%+xoleft%          :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  187.   645  c_ptr_c_n% = cell_ptr_c%+xoright%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  188.   646  c_ptr_c_n% = cell_ptr_c%+yobelow%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  189.   647  c_ptr_c_n% = cell_ptr_c%+yobelow%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  190.   648  c_ptr_c_n% = cell_ptr_c%+yobelow%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)+2
  191.   649  golDrawText$ = fnBgColor(golColor$) + " " : gosub 590
  192.   650  return
  193.   651  'void CellMap::ClearCell(unsigned int x, unsigned int y)
  194.   652  'if fnLocateCheck(y%, x%) then locate y%, x% : print SGR0$ + " " : sleep 0
  195.   653  cell_ptr_c% = (y% * w%) + x%
  196.   654  'calculate the offsets to the eight neighboring cells,
  197.   655  'accounting for wrapping around at the edges of the cell map
  198.   656  xoleft%  = fnIf%((x% = 0), w% -1, -1)
  199.   657  xoright% = fnIf%((x% = (w% - 1)), -1*(w% - 1), 1)
  200.   658  yoabove% = fnIf%((y% = 0), length_in_bytes% - w%, -1*w%)
  201.   659  yobelow% = fnIf%((y% = (h% - 1)),-1*(length_in_bytes% - w%), w%)
  202.   660  cellRaw% = cells%(cell_ptr_c%)
  203.   661  'cellState% = cellRaw% and 1
  204.   662  cells%(cell_ptr_c%) = cellRaw% - (cellRaw% and 1) 'set first bit to 0
  205.   663  'change successive bits for neighbour counts
  206.   664  c_ptr_c_n% = cell_ptr_c%+yoabove%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  207.   665  c_ptr_c_n% = cell_ptr_c%+yoabove%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  208.   666  c_ptr_c_n% = cell_ptr_c%+yoabove%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  209.   667  c_ptr_c_n% = cell_ptr_c%+xoleft%          :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  210.   668  c_ptr_c_n% = cell_ptr_c%+xoright%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  211.   669  c_ptr_c_n% = cell_ptr_c%+yobelow%+xoleft% :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  212.   670  c_ptr_c_n% = cell_ptr_c%+yobelow%         :cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  213.   671  c_ptr_c_n% = cell_ptr_c%+yobelow%+xoright%:cells%(c_ptr_c_n%)=cells%(c_ptr_c_n%)-2
  214.   672  golDrawText$ = SGR0$ + " " : gosub 590
  215.   673  return
  216.   674  'int CellMap::CellState(int x, int y)
  217.   675  cell_ptr_cs% = (y% * w%) + x%
  218.   676  ' Return first bit (LSB: cell state stored here)
  219.   677  golCellState% = cells%(cell_ptr_cs%) and 1
  220.   678  return
  221.   679  'void CellMap::NextGen()
  222.   680  'print SGR0$+"CellMap::NextGen()"
  223.   681  ' Copy to temp map to keep an unaltered version
  224.   682  for cpyIdx% = 0 to length_in_bytes%
  225.   683  temp_cells%(cpyIdx%) = cells%(cpyIdx%)
  226.   684  next cpyIdx%
  227.   685  ' Process all cells in the current cell map
  228.   686  for y% = 0 to h% - 1
  229.   687  for x% = 0 to w% - 1
  230.   688  gosub 692 : sleep 0
  231.   689  next x%
  232.   690  next y%
  233.   691  return
  234.   692  '
  235.   693  cell_ptr% = (y% * w%) + x%
  236.   694  cellRaw% = temp_cells%(cell_ptr%)
  237.   695  ' Zero bytes are off and have no neighbours so skip them...
  238.   696  if cellRaw% = 0 then return
  239.   697  ' Remaining cells are either on or have neighbours
  240.   698  state% = cellRaw% and 1
  241.   699  count% = (cellRaw% - state%) / 2 ' # of neighboring on-cells
  242.   700  if state% = 1 then gosub 704 : return
  243.   701  if state% = 0 then gosub 708 : return
  244.   702  ' Advance to the next cell byte
  245.   703  return
  246.   704  '
  247.   705  ' On cell must turn off if not 2 or 3 neighbours
  248.   706  if (count% <> 2) and (count% <> 3) then gosub 651
  249.   707  return
  250.   708  '
  251.   709  ' Off cell must turn on if 3 neighbours
  252.   710  if count% = 3 then gosub 629
  253.   711  return
  254.   712  'void CellMap::Init()
  255.   713  golColor% = 1 : golColor$ = "white"
  256.   714  gosub 235 : print SGR0$
  257.   715  gosub 725
  258.   716  gosub 235 : print HideCursor$
  259.   717  XI = int((width/2)-(rleX%/2)) : YI = int((height/2)-(rleY%/2))
  260.   718  for yIdx% = 0 to aSplit$(pArr$, "len")
  261.   719  for xIdx% = 1 to len(aSplit$(pArr$, yIdx%))
  262.   720  cell$ = fnAt$(aSplit$(pArr$, yIdx%), xIdx%)
  263.   721  if cell$ = "o" then x% = XI+xIdx% : y% = YI+yIdx% : gosub 629
  264.   722  next xIdx%
  265.   723  next yIdx%
  266.   724  return
  267.   725  '
  268.   726  rle$ = ""
  269.   727  for wGolInput% = 0 to 1 : wGolInput% = 0
  270.   728  input "rle? ", inRle$
  271.   729  if fnStartsWith(inRle$, "#") = 0 and fnStartsWith(inRle$, "x") = 0 then rle$ = rle$ + inRle$
  272.   730  if fnStartsWith(inRle$, "x") then pSplit$ = inRle$
  273.   731  if fnEndsWith(inRle$, "!") or inRle$ = "" then wGolInput% = 1
  274.   732  next wGolInput%
  275.   733  pArr$ = "rleSize" : pDelim$ = " " : gosub 346
  276.   734  for golIdx% = 0 to aSplit$(pArr$, "len")
  277.   735  if aSplit$(pArr$, golIdx%) = "x" then rleX% = val(fnReplace$(aSplit$(pArr$, golIdx% + 2), ",", ""))
  278.   736  if aSplit$(pArr$, golIdx%) = "y" then rleY% = val(fnReplace$(aSplit$(pArr$, golIdx% + 2), ",", ""))
  279.   737  if aSplit$(pArr$, golIdx%) = "rule" then rleRule$ = aSplit$(pArr$, golIdx% + 2)
  280.   738  next golIdx%
  281.   739  print "x:";rleX% : print "y:";rleY% : print "rule:";rleRule$
  282.   740  'print : print rle$
  283.   741  k$ = rle$ : gosub 401
  284.   742  'print : print rleDecode$ : sleep 0
  285.   743  pArr$ = "rleDecode" : pSplit$ = rleDecode$ : pDelim$ = "$" : gosub 346
  286.   744  'gosub 378
  287.   745  print "press any key to start "; : golKey$ = inkey$
  288.   746  return
  289.   747  '
  290.  1407  '
  291.  1408  print "cmdTest"
  292.  1409  gosub 1412
  293.  1410  print "cmdTest complete"
  294.  1411  cmdExec = 1 : return
  295.  1412  '
  296.  1446  gosub 593
  297.  1448  return
  298.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!