Advertisement
Searinox

gol

Aug 2nd, 2020
3,001
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
MapBasic 14.15 KB | None | 0 0
  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