# --------------------------------------------------------------------------
# Copyright (c) 2012 Henry Strickland & Thomas Shanks
# 
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
# --------------------------------------------------------------------------
meth Obj ==
  self eq: a
meth Obj !=
  self ne: a
meth Obj <
  self lt: a
meth Obj <=
  self le: a
meth Obj >
  self gt: a
meth Obj >=
  self ge: a

equals 23  
      1 + 22
equals 'hello'  
      ('h' ap: 'e') ap: ('l' ap: 'lo')
equals 'hello'  
      'he' ap: 'l' $ ap: 'lo'
equals 25  
      3 * 3 + 4 * 4

equals 142  
      m= Dict new. m at: 10 put: 100. (m at: 10) + 42
equals 142  
      m= Dict new. m at: 4 + 6 put: 10 * 10. (m at: 10) + 42

equals 'ok'    
      3 < 5   y::[ 'ok' ] n:: [ 'oops' ]
equals 'oops'    
      8 < 0 y::[ 'ok' ] n:: [ 'oops' ]
equals 'ok'    
      2 < 3   y::[ 'ok' ]
equals nil    
      8 < 0    y::[ 'ok' ]
equals nil    
      -8 < 0    n::[ 'ok' ]

equals 'Vec'
	Vec name

equals 4, 7, 9
    2 * 2; 7; 3 * 3;

equals 'Vec'
	() cls name
equals 0
	() len
equals 'Vec'
	(8;) cls name
equals 1
	(8;) len
equals 'Vec'
	(8,) cls name
equals 1
	(8,) len
equals 25
	x, y = Vec(3, 4).   x * x + y * y.
equals 26
	x, y = 3; 4.   x * x + y * y $ + 1.
equals 26
	x; y = 3, 4.   x * x + y * y $ + 1.

meth Vec eq:
  (a cls name equals: 'Vec')
    n: ['Vec.== expected Vec argument, but got' err: VEC(a, a cls, a cls name, a cls name equals: 'Vec') ]
    y: [
      self len == a len
        n: ['Vec.== got different length Vecs' err: VEC(self, a)]
        y: [
          z= Vec new.
          self len do: [i :
	    z append: ((self at: i) == (a at: i)).
          ].
          z
        ]
      ].

equals 1, 1, 0
  Vec('foo', 100, 'z') == Vec('foo'; 100; 'zoo')

meth Vec collect:
    "Goldberg & Robson, 1989. p215"
    z= self cls new.
    self do: [x :
      z ap: ( a value: x ) ] .
    z

equals VEC( 100, 400, 900. )
  VEC( 10, 20, 30. ) collect: [x :  x * x]

meth Vec select:
    "Goldberg & Robson, 1989. p216"
    z= self cls new .
    self do: [x : .
      ( a value: x ) y: [
        z ap: x ] ] .
    z

meth VecCls pairs:
  z= Vec new.
  FOR{ k,v: a }DO{
    z at: k put: v.
  }.
  z.

equals 10, 20
  ( 10, 20, 30. ) select: [x:  x < 25]


equals 'once-upon-a-time'
  ('once', 'upon', 'a', 'time') join: '-'
  
cls Orphan Usr
meth Orphan handle:query:
  'This class (', se cls name, ') is an Orphan.
  Check its superclass.')jam err.

  DICT{
    'type', 'text';
    'value', (
      'This class <', se cls name, '> is an Orphan.
      Check its superclass.')jam;
  }

cls App Usr
cls Top App

meth Usr nonMain
meth App nonMain

meth TopCls footerButtons
  Vec(
      '|link|/RESET|[RESET]|';
      '|link|/TOP|[Top]|';
      '|link|/BROWSE|[Browse]|';
      '|link|/Eval|[Eval]|';
      '|link|/DemoLife|[DemoLife]|';
      '|link|/DrawLine|[DrawLine]|';
      '|link|/DemoLiveLissajous|[DemoLiveLissajous]|';
      '|link|/DemoStar|[DemoStar]|';
      '|link|/DemoLissajous|[DemoLissajous]|';
      '|link|/DrawRect|[DrawRect]|';
      '|link|/OldStar|[OldStar]|';
      '|link|/DemoHt|[DemoHt]|';
      '|link|/SwitchWorld|[SwitchWorld]|';
      '|link|/ListUnicodePages|[ListUnicodePages]|';
  )

meth Top handle:query:
  "Default class for handling ':'."

  DICT{
    'type' , 'list';
    'title' , 'TOP';
    'value' , VEC{
      '/GamePong';
      '/GameTroids';
      '/EVAL CODE (DoIt, PrintIt)';
      '/BROWSE & EDIT CODE (old)';
      '/BrowseClasses (new)';
      '/BrowseWorlds (broken)';
      '/BrowseFiles';
      '/BrowseHub';
      '/Inspect (not yet useful)';
      '/DemoLiveLifeRedBlue';
      '/DemoLiveLife';
      '/DemoLiveLissajous';
      '/DemoLiveSierpinski';
      '/DemoLivePaint';
      '/DemoStar';
      '/DemoLife';
      '/DemoLissajous';
      '/DrawLine';
      '/DemoForm';
      '/DrawRect';
      '/OldStar';
      '/ListUnicodePages';
      '/SwitchWorld (broken)';
  }}.

cls BrowseFiles App
meth BrowseFiles handle:query:
  v= Ht linkLabelPairs: FOR(fname,time,size: File dir)MAP(
           ('/BrowseFile', fname) join: '.',   fname ).
  DICT(
    'type', 'html';
    'title', 'BrowseFIles';
    'value', v;
  )

cls BrowseFile App
meth BrowseFile handle:query:
  ww= a split: '.' .
  name= (ww at: 1) ap: '.txt'.
  c= File read: name.
  v= TAG('pre', c).
  DICT(
    'type', 'html';
    'title', 'BrowseFile: ' ap: name;
    'value', v;
  )

cls BrowseHub App
meth BrowseHub handle:query:
  v= Ht linkLabelPairs: FOR(fname,time,size: Hub dir)MAP(
           ('/BrowseHubFile', fname) join: '.',   fname ).
  DICT(
    'type', 'html';
    'title', 'BrowseHub';
    'value', v;
  )

cls BrowseHubFile App
meth BrowseHubFile handle:query:
  ww= a split: '.' .
  name= (ww at: 1) ap: '.txt'.
  c= Hub read: name.
  v= TAG('pre', c).
  DICT(
    'type', 'html';
    'title', 'BrowseHubFile: ' ap: name;
    'value', v;
  )

cls Browse App
meth Browse handle:query:
  ww= a split: '.' .
  wl= ww len .
  clss= Cls all .

  "Start the list V with an UP link."
  v= Vec('|link|/Top|[TOP]|', 'Go Top.';).
  v len == 1 $must: (v, '#1').
  v at: 0 $len == 2 $must: (v, '#2').

  ( wl == 1 ) y: [
    "gk are Good Keys, those that are classes."
    gk= clss dir select: [i:
        AND( clss at: i $ cls name ends: 'Cls';
             OR( clss at: i $ name ends: 'Cls' $ not;
                 clss at: i $ cls name == 'ClsCls' ) )
    ].

    gk do: [k:
        kc= clss at: k .
        kn= kc name .
        tmp = ('|link|/Browse.', kn, '|', kn, '|') jam, kc meths dir  join: ' '.
	tmp len == 2 $must: (tmp, '#3').
        v ap: tmp.
	v do: [each: each len == 2 $must: (v, each, '#4')].
    ].

    z= Dict new
        $ at: 'type' put: 'list'
        $ at: 'title' put: 'Browsing All Classes'
        "$ at: 'extra' put: ( clss )"
        "$ at: 'extraKeys' put: ( clss dir )"
        "$ at: 'extraCollect' put: ( clss dir collect: [i:  ( clss at: i ) cls cls name ] )"
        "$ at: 'extraSelect' put: gk"
        $ at: 'value' put: v
	.

  ] .
  
  ( wl == 2 ) y: [
    cn= ww at: 1 .  "class name"
    co= clss at: cn lower .   "class object"
    v ap: ( ('|link|/', cn, '|[RUN]|')jam, '[RUN]').

    v ap: ( ('|link|/Browse.', cn, '|== CLASS ', cn, ' ==|')jam,
            ('==== class ', cn, ' ====')jam ).

    d= co cls meths .
    d dir do: [x:  "For each class method"
      v ap: ( ( '|link|/EditMethod.', cn, 'Cls.', x, '|[method] cls ', x, '|' ) jam, d at: x $ str ) .
    ] .

    d= co meths .
    d dir do: [x:   "For each instance method"
      v ap: ( ( '|link|/EditMethod.', cn, '.', x, '|[method] ', x, '|' ) jam, d at: x $ str ) .
    ] .

    z= Dict new  at: 'type' put: 'list'
          $ at: 'title' put: ( 'Browsing Class' ap: cn )
          $ at: 'value' put: v
        .

  ] .
  z .


cls EditMethod App
meth EditMethod nonMain
meth EditMethod handle:query:
  ww= a split: '.' .
  wl= ww len .
  clss= Cls all .

  ( wl ne: 3 ) y: [ 'wrong words len in EditMethod' err: ww ] .

  cn= ww at: 1 .  "class name"
  mn= ww at: 2 .  "method name"

  co= clss at: cn lower .   "class object"
  mo= co meths at: mn lower .  "method object"

  z= Dict new  at: 'type' p: 'edit'
          $ at: 'title' p: ( 'Editing Class' ap: cn $ ap: ' Method ' $ ap: mn )
          $ at: 'value' p: ( mo str )
          $ at: 'action' p: ( '/SubmitMethod' )
          $ at: 'field1' p: 'ClassName'
          $ at: 'value1' p: cn
          $ at: 'field2' p: 'MethodName'
          $ at: 'value2' p: mn
        .
  z .


cls SubmitMethod App
meth SubmitMethod nonMain
meth SubmitMethod handle:query:

  clss= Cls all .

  cname= b at: 'ClassName' .
  mname= b at: 'MethodName' .

  co= clss at: cname lower .

  z= co definemethod: mname abbrev: '' doc: '' code: ( b at: 'text' ) .

  url= ('/Browse.', cname,)jam.
  'Browse url=' say: url.
  z= Browse new handle: url query: DICT().
  'Browse returns=' say: z.
  z.


cls Eval App
meth Eval handle:query:
  DICT(
    'type', 'edit';
    'title', 'Eval Form';
    'value', '';
    'action', '/SubmitEval';
  ).


cls SubmitEval App
meth SubmitEval nonMain
meth SubmitEval handle:query:
  
  z= Tmp new eval: ( b at: 'text' ).

  DICT(
    'type', 'text';
    'title', 'doit: ' ap: (b at: 'text');
    'value', z str;
  ).


cls DrawLine App
meth DrawLine handle:query:
  DICT( 'type', 'draw';
	'title', 'Drawing a line';
	'value', Vec(
           VEC( 'line', 10, 400, 50, 300, 2 );
	);
	'width', 300;
	'height', 500;
  )

cls OldStar App
meth OldStar handle:query:
  "Event Location."
  ex, ey = b at: 'ex', b at: 'ey'.

  "Default Location."
  ex = IF( ex equals: nil )THEN( 300 )ELSE( ex num ).
  ey = IF( ey equals: nil )THEN( 300 )ELSE( ey num ).

  v = 100 range collect: [i:  theta = i / 10 .
      x= theta sin * 290 + 300.
      y= theta cos * 290 + 300.
      VEC('line', ex, ey, x, y).
  ] .
 
  DICT( 'type', 'draw';
	'title', 'Drawing a line';
	'value', v;
	'width', 600;
	'height', 600;
  ).

cls DemoLife App
vars DemoLife 
  state
meth DemoLife canX
  900
meth DemoLife canY
  500
meth DemoLife numX
  27
meth DemoLife numY
  15
meth DemoLife delX
  self canX idiv: self numX
meth DemoLife delY
  self canY idiv: self numY
meth DemoLife initP
  self numX range collect: [x:
    self numY range collect: [y:
      t = x + y * 13 .
      OR((t imod: 4) == 0,
         (t imod: 5) == 0,
         (t imod: 7) == 0).
    ]
  ].

meth DemoLife draw
  dx,dy= self delX, self delY.
  IF(state is: nil) THEN(state = self initP).

  nextState = self numX range collect: [x:
        self numY range collect: [y:
           nei = 0.
           3 do: [i:  i = i - 1 + x.
             3 do: [j:  j = j - 1 + y.
               nei = nei + ((state at: i) at: j).
             ].
           ].
	   "Notice cell x,y can count as a nei."
           IF((state at: x) at: y)
             THEN( OR(nei == 3;  nei == 4;) )
             ELSE( nei == 3 ).
        ].
      ].
  state = nextState.
  v = Vec new.
  self numX do: [x:
    self numY do: [y:
      (state at: x) at: y $
        y: [
             xx = x * dx + (dx idiv: 2).
             yy = y * dy + (dy idiv: 2).
             v ap: VEC( 'rect',  xx - 12,  yy - 12, 24, 24,).
        ]
        n: [
             xx = x * dx + (dx idiv: 2).
             yy = y * dy + (dy idiv: 2).
             v ap: VEC( 'line',  xx - 2,  yy - 2,
                                 xx + 2,  yy + 2,).
        ].
    ].
  ].
  v.

meth DemoLife handle:query:
  DICT(
    'type', 'draw';
    'width', self canX;
    'height', self canY;
    'value', self draw;
    'url', ( '/', self cls name, '.', self oid str ) jam;
  ).

cls DrawRect App
meth DrawRect handle:query:
  v = Vec new.
  FOR(x : 10) DO(
    FOR(y : 10) DO(
      v append: VEC('rect', 80 * x, 70 * y, 20, 15, 2, 'green').
      v append: VEC('text', 80 * x + 25, 70 * y + 30, (x str, ',', y str) jam ).
    ).
  ).
  DICT( 'type', 'draw';
	'title', 'Drawing 100 Rectangles';
	'value', v;
	'width', 300;
	'height', 500;
  ).


( 1234 cls DemoForm App
) 1234
( 1235 meth DemoForm handle:query:
  br = Tag('br').
  p = Tag('p').
  i1 = Tag('input'; 'name', 'one'; 'value', 'uno').
  i2 = Tag('input'; 'name', 'two'; 'value', 'dos').
  i3 = Tag('input'; 'name', 'three'; 'value', 'tres').
  s = Tag('input'; 'type', 'submit'; 'value', '250 OK').
  form1 = Tag('form'; 'method', 'post'; 'action', '/DemoFormSubmit';
          Ht entity: 'alpha'; i1; br;
	  Ht entity: 'beta'; i2; br;
	  Ht entity: 'gamma'; i3; br;
	  s).
  i1 = Tag('input'; 'name', 'one'; 'value', 'eins').
  i2 = Tag('input'; 'name', 'two'; 'value', 'zwei').
  i3 = Tag('input'; 'name', 'three'; 'value', 'drei').
  form2 = Tag('form'; 'method', 'get'; 'action', '/DemoFormSubmit';
          Ht entity: 'alpha'; i1; br;
	  Ht entity: 'beta'; i2; br;
	  Ht entity: 'gamma'; i3; br;
	  s).
  body = HT('form1:', TAG('pre', form1 str), p, form1, p,
            'form2a:', TAG('pre', form2 str), p, form2, p,
            'form2b:', TAG('pre', form2 str), p, form2, p,
            'form2c:', TAG('pre', form2 str), p, form2, p,
            'form2d:', TAG('pre', form2 str), p, form2, p,
            'form2e:', TAG('pre', form2 str), p, form2, p,
         ).
  DICT(
    'type', 'html';
    'value', Tag('html', Tag('body', body))).
) 1235

( 1236 cls DemoFormSubmit App
) 1236
( 1237 meth DemoFormSubmit handle:query:
  br = Tag('br').
  body = Ht( 
    Ht entity: 'alpha', ' == ', b at: 'one', br,
    Ht entity: 'beta', ' == ', b at: 'two', br,
    Ht entity: 'gamma', ' == ', b at: 'three', br,
    ('a={', a, '} b={', b, '}')jam, br,
    ).
  DICT(
    'type', 'html';
    'value', Tag('html', Tag('body', body))).

) 1237
cls DemoHt App
meth DemoHt handle:query:

  guts = Ht(
    Tag('li', 'Test.'),
    Tag('li', TAG('span'; 'style', 'color:yellow'; 'Hello')),
    Tag('li', TAG('span'; 'style', 'background-color:brown'; 'World!')),
    Tag('li', '[', TAG('a'; 'href', '/Top'; 'GO TOP'), ']'),
    ).
  guts append: Ht(
    FOR(i:100)MAP(
      Tag('li', i))).
  page = TAG('html',
    TAG('body';
        'bgcolor', '#222222';
        'text', '#DDDDDD';
	TAG('big',
	  TAG('big',
	    TAG('ul', guts))))).

 DICT('type', 'html';
   'title', 'DemoHt Title';
   'value', page).

cls ListUnicodePages App
meth ListUnicodePages handle:query:
  ww= a split: '.' .
  IF( ww len == 2 ) 
  THEN( self drawPage: (ww at: 1) num )
  ELSE( self listPages ).


meth ListUnicodePages listPages
  v = FOR(i : 256) MAP(
    link = ('|link|/ListUnicodePages.', i str, '|Page ', i str, '|') jam.
    label = ( 'Page ', i str ) jam.
    (link, label).
  ).
  DICT( 'type', 'list';
	'title', 'Unicode Pages.';
	'value', v;
  ).
  

meth ListUnicodePages drawPage:
  txt = FOR(i : 256) MAP(
    i = i + a*256.
    (i str, ' [', i, '] ').
  ) implode.
  DICT( 'type', 'text';
	'title', 'Unicode Page ' append: a str;
	'value', txt;
  ).

cls SwitchWorld App
meth SwitchWorld handle:query:
  r = Rex new: 'w_([a-z0-9]+).txt'.
  worlds = Vec new.
  'File dir ==' say: File dir.
  FOR(f : File dir) DO(
    'r==' say: r.
    'f0==' say: (f at: 0).
    m = r match: (f at: 0).
    'm==' say: m.
    IF(m) THEN(
      worlds append: (m at: 1).
      'worlds' say: worlds.
    ).
  ).

  links = Ht( FOR(w : worlds) MAP (
    Ht(
      Tag('a'; 'href', '/SwitchWorldSubmit?world=' ap: w; w) say,
      ' | '
  ) say ) say ) say.
  'links' say: links.

  br = Tag('br').
  i1 = Tag('input'; 'name', 'world'; 'value', '').
  s = Tag('input'; 'type', 'submit'; 'value', 'SwitchWorld').


  form = Tag(
    'form'; 'method', 'post'; 'action', '/SwitchWorldSubmit';
    'Switch to a differnt world: '; i1; br;
    s).

  body = Ht(
    'Worlds: ', links,
    br, form
    ).
  DICT(
    'type', 'html';
    'value', Tag('html', Tag('body', body))).


cls SwitchWorldSubmit App
meth SwitchWorldSubmit handle:query:
  DICT(
    'type', 'world';
    'value', b at: 'world';
    ).

cls DrawApp App
vars DrawApp
  scrw scrh path query stuff storage didInit
meth DrawApp nonMain
meth DrawApp handle:query:
  scrw = 1000.
  scrh = 480.
  path = a.
  query = b.
  stuff = Vec new.

  self basicInit.
  self basicStep.

  DICT(
    'type', 'draw';
    'title', self cls name;
    'value', stuff;
    'url', ( '/', self cls name, '.', self oid str ) jam;
  ).
  
meth DrawApp basicInit
  IF (didInit not) THEN (
    self init.
    didInit = 1.
  ).
 
meth DrawApp basicStep
  self step.
 
meth DrawApp init
  self.  "Subclass should override."
 
meth DrawApp step
  self.  "Subclass should override."
 
meth DrawApp line:to:
  x1, y1 = a.
  x2, y2 = b.

  stuff ap: VEC('line', x1, y1, x2, y2).

meth DrawApp rect:to:
  x1, y1 = a.
  x2, y2 = b.
  x, y = (x1 + x2) / 2, y1 + y2 / 2.
  w, h = (x1 - x2) abs, (y1 - y2) abs.

  stuff ap: VEC('rect', x, y, w, h).

meth DrawApp text:sw:
  x, y = b.
  stuff ap: VEC('text', x, y, a).

meth DrawApp store
  storage = stuff.

meth DrawApp recall
  stuff = storage.

cls DemoStar DrawApp
meth DemoStar init
  self.
 
meth DemoStar step
  FOR( i : Num pi * 60 ) DO(
    theta = i * 0.1.
    x = theta cos * 200 + 222.
    y = theta sin * 200 + 222.
    
    self line: (200, 200) to: (x, y).
    "self text: i str sw: (x, y)."
  )
 

cls DemoLissajous DrawApp
vars DemoLissajous 
  numPoints
meth DemoLissajous init
  numPoints = 40.
  se dumpVarMap.
  'init: meths = ' say: (se cls meths).
meth DemoLissajous step
  FOR(i : numPoints) DO(
    b = i / 5 $ cos * 500 + 500,
        i / 3 $ sin * 240 + 240.
    self text: i str sw: b.
    a = b.
  ).
  numPoints = numPoints + 40.

cls LiveApp App
vars LiveApp
  scr red blue green white black
meth LiveApp nonMain
meth LiveApp scr
  scr.
meth LiveApp init
  "nothing to do."
  self.
meth LiveApp onLive
  red= scr newInk: 900.
  green= scr newInk: 90.
  blue= scr newInk: 9.
  white= scr newInk: 999.
  black= scr newInk: 0.

  'draw...' say: ('src=', scr) jam.
  self draw.
  scr post.
  self.
meth LiveApp handle:query:
  block= [scr:
    self onLive].
  DICT(
    'type', 'live';
    'value', block;
    'event', self eventBlk).
  

meth LiveApp red
  red.
meth LiveApp green
  green.
meth LiveApp blue
  blue.
meth LiveApp white
  white.
meth LiveApp black
  black.
meth LiveApp eventBlk
  nil.   "Return a blk [kind: xy: ...] if you accept events"

# Methods from Screen are available here.
meth LiveApp newInk:
  scr newInk: a
meth LiveApp post
  scr post
meth LiveApp clear:
  scr clear: a

cls DemoLiveLissajous LiveApp
meth DemoLiveLissajous draw
  w= se scr width / 2.
  h= se scr height / 2.
  self clear: 0.
  prev= w*2, h.
  n = 1000.
  start = Sys secs.
  FOR(i : n) DO(
    xy= i / 19 $ cos * w + w,
        i / 7 $ sin * h + h.
    self newInk: i 
      $ line: prev to: xy
      $ fontSize: 24
      $ text: i str sw: xy.
    prev= xy.
    self post.
  ).
  finish= Sys secs.
  time= finish - start.
  fps= n / time.
  msg= (n, ' frames / ', time, 's = ', fps, ' fps') jam.
  self white fontSize: 32 $ text: msg sw: (100,100). 

cls DemoLiveLissajousSimple LiveApp
meth DemoLiveLissajousSimple draw
  w= se scr width / 2.
  h= se scr height / 2.
  self clear: 313.
  prev= w*2, h.
  FOR(i : 1000) DO(
    xy= i / 19 $ cos * w + w,
        i / 7 $ sin * h + h.
    self white line: prev to: xy.
    prev= xy.
    self post.
  ).


cls DemoLiveSierpinski LiveApp
meth DemoLiveSierpinski draw
  self clear: 323.
  self post.
  d1 = d2 = d3 = d4 = 0.
  colors = 900, 90, 9.
  ink = self newInk: (colors at: 0).
  corners = 0, 0; 500, 380; 700, 100.
  x, y = corners at: 0.
  n = 100000.
  k = 200.
  self green thick: 2.
  start = Sys secs.
  FOR(i : n) DO(
    r = Num rand: corners len.
    cx, cy = corners at: r.
    x = (x + cx) / 2.
    y = (y + cy) / 2.
    ink color: (colors at: d4) $dot: (x, y).
    IF(i % k $not) THEN(self post).
    d1, d2, d3, d4 = r, d1, d2, d3.
  ).
  finish= Sys secs.
  time= finish - start.
  fps= n / k / time.
  msg= (n / k, ' frames / ', time, 's = ', fps, ' fps') jam.
  self white fontSize: 32 $ text: msg sw: (100,100). 


cls DemoLivePaint LiveApp
meth DemoLivePaint draw
  self clear: 212. "323."
  FOR(i:50) DO(
  FOR(j:30) DO(
    se green text: (i*10+j) str sw: (i*20, j*20).
    self post.
  )).

meth DemoLivePaint eventBlk
  [kind: xy:
   self onEvent: kind at: xy]

meth DemoLivePaint onEvent:at:
  " 'DemoLivePaint------onEvent' say: (a, b). "
  self white text: a str sw: b.

#### More HT Constructors

meth HtCls nbsp
  Ht entity: 'nbsp'

meth HtCls linkLabelPairs:
  HT{
    FOR{elem: a}
    MAP{
      IF{ elem len == 3 }
        THEN{ link,label,extra= elem. }
        ELSE{ link,label= elem.  extra=''. }.
      HT{' '; Ht nbsp; ' '; TAG{'a'; 'href', link; label}; extra; ' '}
    };
    Ht nbsp; ' '
  }

meth HtCls bold:
  TAG('b', a)
meth HtCls box:
  TAG('table'; 'border', '1';
    TAG('tr', TAG('td'; 'border', '0'; HT(a)))
  ).

meth HtCls link:to:
  TAG('a'; 'href',b; a)

meth HtCls vec:
  h= HT().
  FOR(x: a)
  DO(
    h append: TAG('li', HT(x)).
  ).
  TAG('ul', h). 

meth HtCls dict:
  h= HT().
  FOR(k:v: a)
  DO(
    h append: TAG('dt', TAG('b', HT(k))).
    h append: TAG('dd', HT(v)).
  ).
  TAG('dl', h). 

meth HtCls vecvec:
  h= HT().
  FOR(k,v: a)
  DO(
    h append: TAG('dt', TAG('b', HT(k))).
    h append: TAG('dd', HT(v)).
  ).
  TAG('dl', h). 

#### WebApp

cls WebApp App
vars WebApp
 path query
meth WebApp nonMain
meth WebApp wPath
  path
meth WebApp w1
  path split: '.' $ at: 1
meth WebApp w2
  path split: '.' $ at: 2
meth WebApp wQuery
  query

meth WebApp handle:query:
 path,query = a,b.
 self wResult.
meth WebApp wResult
 DICT(
   'type', 'html';
   'value', self wHtml;
   'title', self wTitle;
 ).

meth WebApp wTitle
  self opath
meth WebApp wHtml
  TAG('html', self wHead, self wBody)
meth WebApp wHead
  HT{
    TAG{'title', self wTitle},
    TAG{'style', self wStyle},
  }
meth WebApp wBgColor
  'black'
meth WebApp wFgColor
  'white'
meth WebApp wFontFamily
  'sans-serif'
meth WebApp wFontSize
  '150%'
meth WebApp wFontWeight
  '200'
meth WebApp wStyle
  ('body{
      color:', se wFgColor, ';
      background-color:', se wBgColor, ';
      font-family:', se wFontFamily, ';
      font-size:', se wFontSize, ';
      font-weight:', se wFontWeight, ';
    }
    h1{
      font-family: serif;
      font-size: 200%;
      font-weight: 300;
    }
 ',) jam

meth WebApp wBody
  TAG('body',
    TAG('p', HT{self wTop}),
    TAG('p', HT{self wMid}),
    TAG('hr'),
    TAG('p', HT{self wBottom}))
meth WebApp wTop
  TAG('h3', self wTitle)
meth WebApp wMid
  HT('Hello World!  This is WebApp:wMid. Override me.')
meth WebApp wBottom
  HT(
    FOR(url,label: se wFootLinks)
    MAP(
      ' [',
      TAG('a'; 'href',url; label),
      '] ',
      Ht entity: 'nbsp',
    )
  )
meth WebApp wFootLinks
  '/Top', 'Top';
  '/Inspect.' ap: se opath, 'InspectSelf';
  '/InspectClasses', 'InspectClasses';
  '/Browse', 'Browse';
  '/BrowseClasses', 'Classes';
  '/BrowseFiles', 'Files';
  '/BrowseHub', 'Hub';
  '/BrowseWorlds', 'Worlds';
 
cls SaidWhat WebApp
meth SaidWhat wMid
  Ht vec: Sys said

cls Inspect WebApp
meth Inspect wResult
  ww= se wPath split: '.'.
  CASE{ww len}OF{
    1,
      (InspectRoot new wResult);
    2,
      (
        t = Sys find: (ww at: 1).
        COND{
          t is: nil,
            (InspectSimple new msg: 'nil' $wResult);
          t isa: Cls,
            (InspectClass new targ: t $wResult);
          1,
            (InspectInst new targ: t $wResult);
        }
      );
  }ELSE{Sys throw: 'bad path:' ap: ww repr}

cls InspectRoot WebApp
meth InspectRoot title
  'INSPECT'.
meth InspectRoot wMid
  HT(
    FOR{k:v: Cls all}MAP{
      ' [',
      TAG('a'; 'href', '/Inspect.@' ap: v name; v name),
      '] ',
      Ht entity: 'nbsp', 
    }
  )
  
cls InspectInst WebApp
vars InspectInst
  targ 
meth InspectInst targ:
  targ = a.
  se.
meth InspectInst title
  ('Inspecting ', targ oname)jam
meth InspectInst wMid
  Ht dict: targ peekInstVarsDict
  

cls InspectClass WebApp
vars InspectClass
  targ 
meth InspectClass targ:
  targ = a.
  se.
meth InspectClass title
  ('Inspecting ', targ name)jam
meth InspectClass wMid
  HT('Cls: ', targ str)
  

cls InspectSimple WebApp
vars InspectSimple
  msg 
meth InspectSimple msg:
  msg = a.
  se.
meth InspectSimple title
  ('Inspect: ', msg str)jam
meth InspectSimple wMid
  HT('Inspect: ', msg str)


cls Foo Usr
vars Foo
  x y z
meth Foo x
  x
meth Foo y
  y
meth Foo z
  z
meth Foo x:
  x = a. se
meth Foo y:
  y = a. se
meth Foo z:
  z = a. se

meth Foo one
  se x: 10
  se y: 100
  se z: 1000

cls Bar Foo 
vars Bar 
  r s
meth Bar x
  su x
meth Bar r
  r
meth Bar s
  s
meth Bar one
  r = 1. s = 11. super one.  
  
  se x: 2 * se x.
  se y: 2 * se y.
  se z: 2 * se z.
  se.

meth Foo two
  x + y + z
meth Bar two
  su two + r + s

inst Bar bar1
  DICT('x',111; 'y',222; 'z',333; 'r',1111; 's',2222;)
#equals 333
#  Bar find: 'bar1_pre0' $z

cls BarApp App
meth BarApp handle:query:

  g = ((o=Bar new) one two, '=', o x, o y, o z, o r, o s) join: '  ,,  '.

  dict(
    'type', 'text';
    'value', g str;
  )


################# Life

cls DemoLiveLife LiveApp
vars DemoLiveLife 
  state embargo

meth DemoLiveLife state
  state
meth DemoLiveLife state:
  state= a. se.
meth DemoLiveLife embargo
  embargo
meth DemoLiveLife embargo:
  embargo= a. se.

meth DemoLiveLife numX
  se numY * se scr width / se scr height  $round
meth DemoLiveLife numY
  23

cls DemoLiveLifeSmall DemoLiveLife
meth DemoLiveLifeSmall numY
  11

cls DemoLiveLifeLarge DemoLiveLife
meth DemoLiveLifeLarge numY
  43


meth DemoLiveLife delX
  self scr width  idiv:  self numX
meth DemoLiveLife delY
  self scr height  idiv:  self numY

meth DemoLiveLife initState
  FOR(x: self numX)MAP(
    FOR(y: self numY)MAP(
      Num rand < 0.3
  ) ).
      
meth DemoLiveLife lifeStep
  dx,dy= self delX, self delY.
  dx2,dy2= dx idiv: 2, dy idiv: 2.
  rx,ry= dx2 - 1, dy2 - 1.

  nextState = FOR(x: self numX)MAP(
        FOR(y: self numY)MAP(
           nei = 0.
	   FOR(i: 3)DO(
             i = i - 1 + x.
	     FOR(j: 3)DO(
               j = j - 1 + y.
               nei = nei + ((state at: i) at: j).
             ].
           ].
	   "Notice cell x,y can count as a nei."
           IF((state at: x) at: y)
             THEN( OR(nei == 3;  nei == 4;) )
             ELSE( nei == 3 ).
        ].
      ].
  "Update state, unless embargo is in place."
  IF{embargo < Sys secs}THEN{state = nextState}.
  FOR(x: self numX)DO{
    FOR(y: self numY)DO{
      IF{(state at: x) at: y}
        THEN{
             xx = x * dx + dx2.
             yy = y * dy + dy2.
	     self green rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry).
        }
        ELSE{
             xx = x * dx + dx2.
             yy = y * dy + dy2.
	     self black rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry).
        }
    }
  }.

meth DemoLiveLife eventBlk
  [kind:ij: i,j= ij.
   x = i idiv: self delX.
   y = j idiv: self delY.
   old= (state at: x) at: y.
   IF{old not}THEN{
     (state at: x) at: y put: 1.
     embargo= Sys secs + 1.
     'Life evBlk' say: (kind, i, j, '->', x, y, embargo).
   }
  ]  

meth DemoLiveLife draw
  embargo= 0.
  self black color: 111.
  IF(state is: nil) THEN(state = self initState).
  FOR(i: 1000000)DO(
    self lifeStep.
    self post.
  ).

#####################################
    
cls DemoLiveLifeRedBlue DemoLiveLife

meth DemoLiveLifeRedBlue initState
  FOR{x: self numX}MAP{
    FOR{y: self numY}MAP{
      IF{Num rand < 0.3}
      THEN{
        IF{x < self numX / 2} THEN{11} ELSE{101}
      }ELSE{0}.
  } }.

meth DemoLiveLifeRedBlue lifeStep
  dx,dy= self delX, self delY.
  dx2,dy2= dx idiv: 2, dy idiv: 2.
  rx,ry= dx2 - 1, dy2 - 1.

  pop = popR = popB = 0.  
  nextState = 
     FOR{x: self numX}
     MAP{
       xx = x * dx + dx2.
       FOR{y: self numY}
       MAP{
         yy = y * dy + dy2.
         colored = 0.
	 FOR(i: 3)DO{
           i = i - 1 + x.
	   FOR(j: 3)DO{
             j = j - 1 + y.
             colored = colored + ((self state at: i) at: j).
           }.
         }.
	 "Notice cell x,y can count as a colored".
	 "Simple neighbor count (no color)".
         bw = colored % 10.
         old= (self state at: x) at: y.

         z= IF{old}
            THEN{ OR{bw == 3;  bw == 4;} }
            ELSE{ bw == 3 }.
         IF{old} THEN{
             rc = (old idiv: 10) % 10.
             bc = (old idiv: 100) % 10.
         } ELSE{
             "Red & Blue counts".
             rc = (colored idiv: 10) % 10.
             bc = (colored idiv: 100) % 10.
         }.
         z= COND{
           z == 0 , (clr = self black. 0);
           rc > bc, (pop=pop+1. popR=popR+1. clr = self red. 11);
           rc < bc, (pop=pop+1. popB=popB+1. clr = self blue. 101);
           1      , (pop=pop+1. clr = self white.  1);
         }.
         clr rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry).
         z.
      }. "next y"
    }. "next x"

  'FINISHED lifeStep' say: (pop, popR, popB).
  self state: nextState.

#####################################

cls BrowseClasses WebApp
meth BrowseClasses wTitle
  'Browse Classes'
meth BrowseClasses wMid
  HT{
   TAG('p'),
   TAG('b', 'Main App Classes: '),
   Ht linkLabelPairs:
   FOR{name:c: Cls all
   }MAP{
      ('/BrowseClass', c name)join:'.',
      c name
   }IF{
     AND{c at: 'nonmain' $not;   c isa: AppCls;}
   },

   TAG('p'),
   TAG('b', 'NonMain App Classes: '),
   Ht linkLabelPairs:
   FOR{name:c: Cls all
   }MAP{
      ('/BrowseClass', c name)join:'.',
      c name
   }IF{
     AND{c at: 'nonmain';   c isa: AppCls;}
   },

   TAG('p'),
   TAG('b', 'Other Usr Classes: '),
   Ht linkLabelPairs:
   FOR{name:c: Cls all
   }MAP{
      ('/BrowseClass', c name)join:'.',
      c name
   }IF{
     AND{c isa: UsrCls;   c isa: AppCls $not;}
   },

   TAG('p'),
   TAG('b', 'Other Classes: '),
   Ht linkLabelPairs:
   FOR{name:c: Cls all
   }MAP{
      ('/BrowseClass', c name)join:'.',
      c name
   }IF{ AND{c isa: UsrCls $not;  c cls is: MetaCls $not}
   },

   TAG('p'),
   TAG('b', 'Class Classes: '),
   Ht linkLabelPairs:
   FOR{name:c: Cls all
   }MAP{
      ('/BrowseClass', c name)join:'.',
      c name
   }IF{ AND{c cls is: MetaCls;}
   },

  }
  
cls BrowseClass WebApp
meth BrowseClass wTitle
  cn= se w1.
  ('Browse Class <', cn, '>') jam.
meth BrowseClass wMid
  cn= se w1.
  c= Cls at: cn lower.
  HT{
    TAG('b', 'Methods: ');
    FOR{ name:m: c meths }MAP{
      HT{
        Ht link: m name
           to: ('/BrowseMethod.', cn, '.', m name)jam,
        ' ', Ht entity: 'nbsp', ' '
      }
    };

    TAG('p');
    TAG('b', 'Class Methods: ');
    FOR{ name:m: c cls meths }MAP{
      HT{
        Ht link: ('cls', m name)join
           to: ('/BrowseMethod.', cn, 'Cls.', m name)jam,
        ' ', Ht entity: 'nbsp', ' '
      }
    };

    TAG('p');
    TAG('hr');
    IF{ c isa: AppCls }THEN{
      Ht link: 'RUN this App.' to: ('/', c name)jam
    }ELSE{ '' };

    TAG('p');
    TAG('hr');

    TAG('b', 'Instance Variables: ');
    TAG('br');
    TAG('form';
        'method','GET';
        'action',('/SubmitInstVars',cn)join:'.';
        'Variable Names (space separated):';
        TAG('input';
            'name','vars';
	    'value', c vars join);
        TAG('p');
        TAG('input';
            'type','submit';
            'value','Define';);
    );

    TAG('p');
    TAG('hr');

    TAG('b', 'Define New Method: '),
    TAG('br');
    TAG('form';
        'method','GET';
        'action',('/SubmitNewMethod',cn)join:'.';
        'Name of method: ';
        TAG('input';
            'name','method';);
        TAG('p');
        TAG('input';
            'type','checkbox';
            'name','clsmeth';
            'value','1';);
        'Class Method';
        TAG('p');
        TAG('input';
            'type','submit';
            'value','Define';);
    );

    TAG('p');
    TAG('hr');
    
    Ht link: 'Define a subclass.'
       to: (('/FormCreateSubclass', c name) join: '.');
  }

 
cls SubmitInstVars WebApp
meth SubmitInstVars nonMain
meth SubmitInstVars wResult
  cn= se w1.
  c= Cls at: cn.
  vars= se wQuery at: 'vars'.

  c defvars: vars.

  url= ('/BrowseClass', cn) join: '.'.
  BrowseClass new handle: url query: Dict new
    $ at: 'toast' put: 'Defined vars'.

cls SubmitNewMethod WebApp
meth SubmitNewMethod nonMain
meth SubmitNewMethod wResult
  cn,mn= se w1, se wQuery at: 'method'.
  c= Cls at: cn.
  clsmeth= se wQuery at: 'clsmeth'.

  IF{ clsmeth }THEN{ x = c cls }ELSE{ x = c }.
  x defineMethod: mn abbrev: '' doc: '' code: '"TODO"' .

  url= ('/BrowseClass', cn) join: '.'.
  BrowseClass new handle: url query: Dict new
    $ at: 'toast' put: 'Defined method'.

  
cls BrowseMethod WebApp
meth BrowseMethod wTitle
  cn,mn= se w1, se w2.
  ('Browse Method <', cn, ' ', mn, '>') jam.
meth BrowseMethod wMid
  cn,mn= se w1, se w2.
  c= Cls all at: cn lower.
  m= c meths at: mn lower.
  HT{  
    TAG{'pre', m str};
    TAG{'hr'};
    Ht link: 'EDIT' to: ((
      '/EditMethod', cn, mn) join: '.');
  }
 

cls Config Usr
vars Config
  d
meth ConfigCls load
  "Load or create."
  z= Config new.
  TRY{
    'Config' say: (File read: 'c_config.txt').
    "assume any error is 'file not found' ."
  }CATCH{e:
    'Creating new Config.' say.
    z d: Dict new.
    z save.
  }.
  z d: (self eval: (File read: 'c_config.txt')).
  z.

meth Config d
  d
meth Config d:
  d= a
meth Config save
  File write: 'c_config.txt' value: d repr.


cls BrowseWorlds WebApp
vars BrowseWorlds
  cfg
meth BrowseWorlds wTitle
  'Worlds'
meth BrowseWorlds notes:
  'BrowseWorlds' say: (a, cfg d).
  s= IF{ Sys worldName $equals: a }THEN{ '(CURRENT)' }ELSE{ '' }.
  t= IF{ cfg d at: a $equals: 's' }THEN{ '(shared)' }ELSE{ '' }.
  u= IF{ cfg d at: a $equals: 'd' }THEN{ '(fetched)' }ELSE{ '' }.
  (s,t,u)jam say.
meth BrowseWorlds wMid
  r = Rex new: 'w_([a-z0-9]+).txt' say.
  all= Dict new.
  fv= Dict new.
  FOR{fname,mtime,size: File dir}
    DO{m=r match: fname say $say.
       IF{m}THEN{
         name=m at: 1.
         fv at: name put: size.  all at: name put: size}}.
  hv= Dict new.
  notice = ''.
  TRY{
    FOR{fname,mtime,size: Hub dir}
      DO{m=r match: fname say $say.
         IF{m}THEN{
           name=m at: 1.
           hv at: name put: size.  all at: name put: size}}.
  }CATCH{e:
    notice = ('Cannot list HUB files: ', e str.)jam.
  }.

  onlyLocal= FOR{fname:size: fv say}
    MAP{fname}IF{hv at: fname say$say $not}.
  onlyHub= FOR{fname:size: hv say}
    MAP{fname}IF{fv at: fname say$say $not}.
  both= FOR{fname:size: fv say}
    MAP{fname}IF{hv at: fname say$say }.

  cfg= Config load.

  HT{
    notice;
    TAG('p');
    Ht bold: 'Local Worlds: ';
    Ht linkLabelPairs: FOR{f: onlyLocal}
      MAP{('/BrowseLocalWorld', f) join: '.';  f;  se notes: f};
    TAG('p');

    Ht bold: 'Local+Remote Worlds: ';
    Ht linkLabelPairs: FOR{f: both}
      MAP{('/BrowseBothWorld', f) join: '.';  f;  se notes: f};
    TAG('p');

    Ht bold: 'Remote Worlds: ';
    Ht linkLabelPairs: FOR{f: onlyHub}
      MAP{('/BrowseRemoteWorld', f) join: '.';  f;  se notes: f};
    TAG('p');
  }.

cls BrowseLocalWorld WebApp
meth BrowseLocalWorld wTitle
  wn=se w1.
  ('Local World:', wn) join
meth BrowseLocalWorld wMid
  wn=se w1.
  cfg= Config load.

  mode= cfg d at: wn.
  IF{ mode equals: 's' }THEN{
    "already shared; offer sync."
    p= ('/WorldSyncUp', wn) join: '.'; '(SyncUp)'.
  }ELSE{
    "not yet shared; offer share."
    p= ('/WorldShareUp', wn) join: '.'; '(Share)'.
  }.

  HT{
    Ht linkLabelPairs: (p,).
    TAG{'p'}.
    "dict change world?"
  }.

cls BrowseBothWorld WebApp
meth BrowseBothWorld wTitle
  wn=se w1.
  ('Local+Remote World:', wn) join
meth BrowseBothWorld wMid
  wn=se w1.
  cfg= Config load.

  mode= cfg d at: wn.
  COND{
    (mode equals: 's'),(
      p= ('/WorldSyncUp', wn) join: '.'; '(SyncUp)'.);
    (mode equals: 'd'),(
      p= ('/WorldSyncDown', wn) join: '.'; '(SyncDown)'.);
    (1),(
      "neither up nor down: they just have the same name."
      p= ('/WorldCONFLICT', wn) join: '.'; '(CONFLICT)'.);
  }.

  Ht linkLabelPairs: (p,).

cls BrowseRemoteWorld WebApp
meth BrowseRemoteWorld wTitle
  wn=se w1.
  ('Remote World:', wn) join
meth BrowseRemoteWorld wMid
  wn=se w1.
  cfg= Config load.

  mode= cfg d at: wn.
  IF{ mode equals: 'd' }THEN{
    "already downloaded; offer sync."
    p= ('/WorldSyncDown', wn) join: '.'; '(SyncDown)'.
  }ELSE{
    "not yet fetched; offer fetch."
    p= ('/WorldFetch', wn) join: '.'; '(Fetch)'.
  }.

  Ht linkLabelPairs: (p,).

cls WorldShareUp WebApp
meth WorldShareUp wTitle
  wn=se w1.
  ('Share World:', wn) join.
meth WorldShareUp wMid
  wn=se w1.
  cfg= Config load.
  cfg d at: wn put: 's'.
  cfg save.

  p= ('/WorldSyncUp', wn) join: '.'; '(SyncUp)'.
  HT{
    'World marked to sync up.';
    TAG{'p'};
    Ht linkLabelPairs: (p,);
  }

cls WorldSyncUp WebApp
meth WorldSyncUp wTitle
  wn=se w1.
  ('SyncUp World:', wn) join.
meth WorldSyncUp wMid
  wn=se w1.
  fn= ('w_', wn lower, '.txt')jam.

  Hub write: fn value: (File read: fn).
  p= '/BrowseWorlds'; '(BrowseWorlds)'.
  HT{
    'Sync up successful.';
    TAG{'p'};
    Ht linkLabelPairs: (p,);
  }

cls WorldFetch WebApp
meth WorldFetch wTitle
  wn=se w1.
  ('Fetch World:', wn) join.
meth WorldFetch wMid
  wn=se w1.
  fn= ('w_', wn lower, '.txt')jam.
  'filename' say: fn.
  nl=VEC{10,} implode.

  guts= Hub read: fn.
  'guts cls' say: guts cls.
  guts must: [
    VEC{'Cannot read world', wn, 'from the Hub.'}join
  ].

  lines= guts split: nl.
  sb= Buf new.
  state= 0.
  FOR{s: lines}
  DO{
    IF{s == '>>>>>>>>'}THEN{state=0}.
    IF{state==1}THEN{sb ap: s $ap: nl}.
    IF{s == '<<<<<<<<'}THEN{state=1}.
  }.
  File write: fn value: sb str.

  p= '/BrowseWorlds'; '(BrowseWorlds)'.
  HT{
    'Sync down successful.';
    TAG{'p'};
    Ht linkLabelPairs: (p,);
  }

cls FormCreateSubclass WebApp
meth FormCreateSubclass wTitle
  cn= se w1.
  ('Create Subclass of', cn) join.
meth FormCreateSubclass wMid
  cn= se w1.
  TAG('form';
      'method','GET';
      'action',('/SubmitCreateSubclass',cn)join:'.';
      'Name of subclass: ';
      TAG('input';
          'name','subcls';);
      TAG('p');
      TAG('input';
          'type','submit';
          'value','Create Subclass';);
  ).

cls SubmitCreateSubclass WebApp
meth SubmitCreateSubclass wTitle
  cn= se w1.
  subcn= se wQuery at: 'subcls'.
  ('Created subclass', subcn, 'of', cn) join.
meth SubmitCreateSubclass wMid
  cn= se w1.
  c= cls at: cn.

  subcn= se wQuery at: 'subcls'.
  subc= Cls at: subcn.
  IF{ subc }THEN{
    supsubc= subc supercls.
    IF{ supsubc equals: (cls at: cn) }THEN{
      "ok"
    }ELSE{
      ('CONFLICT:',subc,'already exists and has superclass',supsubc)join err.
    }
  }ELSE{
    subc= c defsub: subcn.
  }.

  HT link: subc name to: (('/BrowseClass', subc name) join: '.').


############################
cls GamePong LiveApp
vars GamePong
  n s e w ww hei wid bx by vx vy  pad  hit miss

meth GamePong draw
  hei= se scr height.
  wid= se scr width.
  ww= 20.  "wall width."
  "north, south, east, west boundaries, where ball reflects."
  n= ww.
  s= hei - ww.
  e= wid - ww.
  w= ww.
  hit= miss= 0.
  se white fontSize: 48.

  "Determine fps by posting twice."
  bx, by = ww neg, ww neg.
  vx, vy = 0, 0.
  pad = hei / 2.
  se drawPong.
  se post.
  se drawPong.
  se post.
  se resetBall.

  WHILE{1} DO{
    se moveBall.
    se drawPong.
    se post.
    vx = vx * 1.001.
  }.


meth GamePong resetBall
  bx, by = 2 * ww, ww + (Num rand: hei - 2*ww). "ball position."
  vx, vy = 8, 4. "ball velocity."


meth GamePong drawPong
  se clear: 213.
  se white rect: (0,0) to: (wid,ww). "top"
  se white rect: (0,s) to: (wid,hei). "bottom"
  se white rect: (0,n) to: (w,s). "left"
  w2 = ww / 2.
  se blue rect: (bx-w2, by-w2) to: (bx+w2, by+w2).
  se green rect: (e, pad - ww*1.8) to: (wid, pad + ww*1.8).
  fps = se scr fps.
  IF{fps is: nil $not}THEN{fps= fps fmt: '%.2f'}.
  se white
    text: (hit str, ':', miss str, '   (', fps, 'fps)')join 
    sw: (2*ww, hei - 2*ww).

meth GamePong moveBall
  fps= se scr fps.
  fps= IF{fps is: nil} THEN{20} ELSE {fps}.
  bx, by = bx + vx*30 / fps, by + vy*30 / fps.
  IF(bx <= w)THEN(bx= w + (w-bx). vx = vx neg.).
  IF(by <= n)THEN(by= n + (n-by). vy = vy neg.).
  IF(by >= s)THEN(by= s - (by-s). vy = vy neg.).

  IF{bx >= e}THEN{
    IF{by - pad $abs <= ww*1.8} THEN{
      "paddle hit."
      bx= e - (bx-e).
      vy = vx * (by - pad) / ww.
      vx = vx neg.
      hit = hit + 1.
    }ELSE{
      "paddle miss."
      miss = miss + 1.
      se resetBall.
    }
  }.
  
meth GamePong eventBlk
  [kind: xy:
   self onEvent: kind at: xy]

meth GamePong onEvent:at:
  x,y= b.
  pad= x / wid * hei.

############################
cls GameTroids LiveApp
vars GameTroids
  aa bb ship hei wid

meth GameTroids newAster
  TroidsAster new $ink: se white $sz: 30 $init: se.

meth GameTroids newBullet
  TroidsThing new $ink: se red $sz: 3 $ttl: 12.0 $init: se.

meth GameTroids newShip
  TroidsThing new $ink: se green $sz: 10 $init: se.

meth GameTroids draw
  hei= se scr height.
  wid= se scr width.
  se setup.
  WHILE{1}DO{se step.}.

meth GameTroids setup
  aa = Vec new.
  w2,h2= wid / 2, hei / 2.
  FOR{x: 100, w2, wid - 100}DO{
    FOR{y: 100, h2, hei - 100}DO{
      IF{OR{x ne: w2; y ne: h2}}THEN{
        a= se newAster
           $px: x $py: y
           $vx: Num rand * 2 - 1
           $vy: Num rand * 2 - 1.
        aa ap: a.
      }.
    }.
  }.
  bb = Vec new.
  "bb ap: (se newBullet $px: wid/2 $py: hei/2 $vx: 1 $vy: 0.3)."
  se white fontSize: 24.
  ship= (se newShip $px: wid/2 $py: hei/2 $vx: 0 $vy: 0).

meth GameTroids step
  se clear: COND{ship ttl < 0, 400; aa len < 1, 40; 1, 202;}.
  FOR{ast: aa} DO{
    ast step: se.
    ast draw: se.
  }.
  FOR{bul: bb} DO{
    bul step: se.
    bul draw: se.
  }.
  ship step: se.
  ship draw: se.

  "frames per sec"
  se white text: ((se scr fps ifNil:[0]) fmt: '%.2f fps') str sw: (20,40).

  se post.

  "check collisions."
  FOR{ast: aa} DO{
    FOR{bul: bb} DO{
      dx= ast px - bul px $abs.
      dy= ast py - bul py $abs.
      IF{dx+dy < ast sz + bul sz} THEN{
        ast ttl: -1.
        bul ttl: -1.
      }.
    }.
    dx= ast px - ship px $abs.
    dy= ast py - ship py $abs.
    IF{dx+dy < ast sz + ship sz} THEN{
      ship ttl: -1.
      ship ink: se red.
    }.
  }.
  
  "Cleanup expired asteroids."
  aa= FOR{a: aa}MAP{a}IF{a ttl > 0}.

  "Cleanup expired bullets."
  bb= FOR{b: bb}MAP{b}IF{b ttl > 0}.


meth GameTroids eventBlk
  [kind: xy:
   IF{kind==0}THEN{self onEvent: kind at: xy}.
  ]

meth GameTroids onEvent:at:
  x,y= b.
  x,y= x - ship px, y - ship py.  "ship-relative"
  hyp= x*x + y*y pow: 0.5.
  p,q = x / hyp, y / hyp.
  IF{bb len < 4} THEN{
    bb ap: (se newBullet $px: ship px $py: ship py $vx: p + ship vx $vy: q + ship vy).
  }.
  ship vx: ship vx - p * 0.2 .
  ship vy: ship vy - q * 0.2 .

cls TroidsThing Usr
vars TroidsThing
  px py vx vy sz ink xyxy ww hh ttl

meth TroidsThing px "position x"
  px
meth TroidsThing py "position y"
  py
meth TroidsThing vx "velocity x"
  vx
meth TroidsThing vy "velocity y"
  vy
meth TroidsThing sz "radius"
  sz
meth TroidsThing ink "draw with"
  ink
meth TroidsThing xyxy "polygonal corners"
  xyxy
meth TroidsThing ww "torus width offsets"
  ww
meth TroidsThing hh "torus height offsets"
  hh
meth TroidsThing ttl "time to live"
  ttl


meth TroidsThing px:
  px= a. se.
meth TroidsThing py:
  py= a. se.
meth TroidsThing vx:
  vx= a. se.
meth TroidsThing vy:
  vy= a. se.
meth TroidsThing sz:
  sz= a. se.
meth TroidsThing ink:
  ink= a. se.
meth TroidsThing xyxy:
  xyxy= a. se.
meth TroidsThing ttl:
  ttl= a. se.

meth TroidsThing init:
  hei= a scr height.
  wid= a scr width.
  xyxy= VEC{
    sz neg, sz;
    sz neg, sz neg;
    sz, sz neg;
    sz, sz;
  }.
  ww= wid neg, 0, wid.
  hh= hei neg, 0, hei.
  IF{ttl is: nil}THEN{ttl= 999999999}.
  se.

meth TroidsThing draw:
  FOR{w: ww}DO{
    FOR{h: hh}DO{
      ink rect: (w + px - sz, h + py - sz) to: (w + px + sz, h + py + sz).
    }.
  }.
  
meth TroidsThing step:
  hei= a scr height.
  wid= a scr width.
  fps= a scr fps.
  fps= IF{fps is: nil} THEN{20} ELSE {fps}.
  px= px + vx * 100 / fps.
  py= py + vy * 100 / fps.
  px= px % wid + wid $ % wid.
  py= py % hei + hei $ % hei.
  ttl= ttl - 1 / fps.

cls TroidsAster TroidsThing
vars TroidsAster

meth TroidsAster init:
  super init: a.
  sixty= Num pi / 3.
  se xyxy: FOR{i:6}MAP{
    r= 0.5 + 0.5 * Num rand.
    rad,theta= se sz * r, i * sixty.
    (rad * theta cos, rad * theta sin).
  }.
  se.

meth TroidsAster draw:
  x1,y1= se xyxy at: -1.
  FOR{x2,y2: se xyxy} DO{
    FOR{w: se ww}DO{
      FOR{h: se hh}DO{
        se ink line: (w + se px+x1, h + se py+y1)
                to: (w + se px+x2, h + se py+y2).
      }.
    }.
    x1,y1= x2,y2.
  }


##END
