# -------------------------------------------------------------------------- # 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