# vim: set expandtab:sw=2:ts=2 # -------------------------------------------------------------------------- # 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. # -------------------------------------------------------------------------- # # If you edit this file, run "make", and be sure to Refresh (F5 in eclipse) # the "res" folder in the terse-a1 project, before you build or run it. # # If you edit the Wrapper Markups (=cls =vars =meth) in comments in .java # files, be sure to run "make", and refresh the appropriate Wrap*.java file. # # You need the "make" command and "tclsh" (the Tcl command line) # istalled on your computer. # # -------------------------------------------------------------------------- meth Obj == me eq: a meth Obj != me ne: a meth Obj < me lt: a meth Obj <= me le: a meth Obj > me gt: a meth Obj >= me 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 '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 a0 me at: 0 meth Vec a1 me at: 1 meth Vec a2 me at: 2 meth Vec a3 me at: 3 meth Vec eq: IF( a cls name equals: 'Vec' )THEN( IF( me len == a len )THEN( FOR( i: me len )MAP( (me at: i) == (a at: i). ). )ELSE( 'Vec.== got different length Vecs' err: VEC(me len, a len) ) )ELSE( 'Vec.== expected Vec argument, but got' err: a cls ) equals 1, 1, 0 Vec('foo', 100, 'z') == Vec('foo'; 100; 'zoo') equals VEC( 100, 400, 900. ) FOR( y: 10, 20, 30 )MAP( y*y ) meth VecCls pairs: z= Vec new. FOR{ k,v: a }DO{ z at: k put: v. }. z. equals 100, 400 FOR( x: 10, 20, 30 )MAP( x*x )IF( x < 25 ) equals 'once-upon-a-time' ('once', 'upon', 'a', 'time') join: '-' meth Vec flat z= Vec new. me flattenTo: z. z. meth Obj flattenTo: a ap: me. me. meth Vec flattenTo: FOR(x: me) DO( x flattenTo: a ). me. equals VEC(10, ) VEC(10, )flat equals VEC(10, 20, 30, 40, 50) (10, (20, 30), (), ( (), (40), ), 50)flat cls Orphan Usr meth Orphan handle:query: 'This class (', me cls name, ') is an Orphan. Check its superclass.')jam err. DICT{ 'type', 'text'; 'value', ( 'This class <', me 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{ '/BrowseCLASSES (NEW)'; '/VuDemo'; '/FnordCheeseDemo'; '/FnordCannon'; '/FnordDebugRot'; '/FnordApp'; '/BlocksDemo'; '/FnordTwo'; '/FnordMotherShip'; '/FnordFlight'; '/DualFlight'; '/GameFoo'; '/GamePong'; '/PongGame'; '/DrawAct'; '/GameTroids'; '/SnapshotWorld'; '/EVAL CODE (DoIt, PrintIt)'; '/BROWSE & EDIT CODE (old)'; '/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: '.' . fn= (ww at: 1) ap: '.txt'. c= File read: fn. url= ('/EditFile.', fn)jam. v= HT( TAG('pre', c); TAG('p'); TAG('hr'); TAG('a'; 'href', url; '[EDIT]'); ). DICT( 'type', 'html'; 'title', 'BrowseFile: ' ap: fn; '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'). IF( wl == 1 )THEN( "gk are Good Keys, those that are classes." gk= FOR( i: clss dir )MAP( i )IF( AND( clss at: i $ cls name ends: 'Cls'; OR( clss at: i $ name ends: 'Cls' $ not; clss at: i $ cls name == 'ClsCls' ) ) ). FOR( k: gk )DO( 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. FOR( each: v )DO( each len == 2 $must: (v, each, '#4') ). ). z= Dict new $ at: 'type' put: 'list' $ at: 'title' put: 'Browsing All Classes' $ at: 'value' put: v . ) . IF( wl == 2 )THEN( 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 . FOR( x: d dir )DO( "For each class method" v ap: ( ( '|link|/EditMethod.', cn, 'Cls.', x, '|[method] cls ', x, '|' ) jam, d at: x $ str ) . ). d= co meths . FOR( x: d dir )DO( "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 . IF( wl ne: 3 )THEN( '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' put: 'edit' $ at: 'title' put: ( 'Editing Class' ap: cn $ ap: ' Method ' $ ap: mn ) $ at: 'value' put: ( mo str ) $ at: 'action' put: ( '/SubmitMethod' ) $ at: 'field1' put: 'ClassName' $ at: 'value1' put: cn $ at: 'field2' put: 'MethodName' $ at: 'value2' put: 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. ########### ### HelloName: Small question & answer demo. cls HelloName App meth HelloName handle:query: DICT( 'type', 'edit'; 'title', 'What''s Your Name?'; 'value', ''; 'action', '/SubmitHelloName'; ). cls SubmitHelloName App meth SubmitHelloName nonMain meth SubmitHelloName handle:query: z= b at: 'text'. DICT( 'type', 'text'; 'title', 'I know your name.'; 'value', ('Your name is ', z, '.') jam; ). ########### 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 EditFile App meth EditFile handle:query: fn= (a split: '.' $at: 1, '.txt')jam. DICT( 'type', 'edit'; 'title', 'Eval Form'; 'value', File read: fn; 'action', ('/SubmitEditFile.', fn)jam; ). cls SubmitEditFile App meth SubmitEditFile nonMain meth SubmitEditFile handle:query: fn= (a split: '.' $at: 1, '.txt')jam. x= b at: 'text'. File write: fn value: x. DICT( 'type', 'text'; 'title', fn; 'value', ('Saved ', fn, ', ', x len, ' bytes.')jam ). 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 = FOR( i: 100 )MAP( 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 me canX idiv: me numX meth DemoLife delY me canY idiv: me numY meth DemoLife initP FOR( x: me numX )MAP( FOR( y: me numY )MAP( t = x + y * 13 . OR((t imod: 4) == 0, (t imod: 5) == 0, (t imod: 7) == 0). ) ). meth DemoLife draw dx,dy= me delX, me delY. IF(state is: nil) THEN(state = me initP). nextState = FOR( x: me numX )MAP( FOR( y: me 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 ). ). ). state = nextState. v = Vec new. FOR( x: me numX )DO( FOR( y: me numY )DO( IF( (state at: x) at: y )THEN( xx = x * dx + (dx idiv: 2). yy = y * dy + (dy idiv: 2). v ap: VEC( 'rect', xx - 12, yy - 12, 24, 24,). )ELSE( 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', me canX; 'height', me canY; 'value', me draw; 'url', ( '/', me cls name, '.', me 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( me drawPage: (ww at: 1) num ) ELSE( me 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', 'get'; '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. me basicInit. me basicStep. DICT( 'type', 'draw'; 'title', me cls name; 'value', stuff; 'url', ( '/', me cls name, '.', me oid str ) jam; ). meth DrawApp basicInit IF (didInit not) THEN ( me init. didInit = 1. ). meth DrawApp basicStep me step. meth DrawApp init me. "Subclass should override." meth DrawApp step me. "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 me. meth DemoStar step FOR( i : Num pi * 60 ) DO( theta = i * 0.1. x = theta cos * 200 + 222. y = theta sin * 200 + 222. me line: (200, 200) to: (x, y). "me text: i str sw: (x, y)." ) cls DemoLissajous DrawApp vars DemoLissajous numPoints meth DemoLissajous init numPoints = 40. me dumpVarMap. 'init: meths = ' say: (me cls meths). meth DemoLissajous step FOR(i : numPoints) DO( b = i / 5 $ cos * 500 + 500, i / 3 $ sin * 240 + 240. me 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." me. 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. me draw. scr post. me. meth LiveApp handle:query: block= FN( scr: me onLive ). DICT( 'type', 'live'; 'value', block; 'event', me 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 FN(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= me scr width / 2. h= me scr height / 2. me 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. me newInk: i $ line: prev to: xy $ fontSize: 24 $ text: i str sw: xy. prev= xy. me post. ). finish= Sys secs. time= finish - start. fps= n / time. msg= (n, ' frames / ', time, 's = ', fps, ' fps') jam. me white fontSize: 32 $ text: msg sw: (100,100). cls DemoLiveLissajousSimple LiveApp meth DemoLiveLissajousSimple draw w= me scr width / 2. h= me scr height / 2. me clear: 313. prev= w*2, h. FOR(i : 1000) DO( xy= i / 19 $ cos * w + w, i / 7 $ sin * h + h. me white line: prev to: xy. prev= xy. me post. ). cls DemoLiveHappyRect LiveApp meth DemoLiveHappyRect draw w= me scr width. h= me scr height. me clear: 0. WHILE(1) DO( c = Num rand: 1000. x1 = Num rand: w. x2 = Num rand: w. y1 = Num rand: h. y2 = Num rand: h. me newInk: c $ rect: x1@y1 to: x2@y2. me post. ). cls DemoLiveHappyLine LiveApp meth DemoLiveHappyLine draw w= me scr width. h= me scr height. me clear: 0. WHILE(1) DO( c = Num rand: 1000. x1 = Num rand: w. x2 = Num rand: w. y1 = Num rand: h. y2 = Num rand: h. me newInk: c $ line: x1@y1 to: x2@y2. me post. ). cls DemoLiveSierpinski LiveApp meth DemoLiveSierpinski draw me clear: 323. me post. d1 = d2 = d3 = d4 = 0. colors = 900, 90, 9. ink = me newInk: (colors at: 0). corners = 0, 0; 500, 380; 700, 100. x, y = corners at: 0. n = 100000. k = 200. me 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(me 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. me white fontSize: 32 $ text: msg sw: (100,100). cls DemoLivePaint LiveApp meth DemoLivePaint draw me clear: 212. "323." FOR(i:50) DO( FOR(j:30) DO( me green text: (i*10+j) str sw: (i*20, j*20). me post. )). meth DemoLivePaint eventBlk FN( kind: xy: me onEvent: kind at: xy) meth DemoLivePaint onEvent:at: " 'DemoLivePaint------onEvent' say: (a, b). " me 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. me wResult. meth WebApp wResult DICT( 'type', 'html'; 'value', me wHtml; 'title', me wTitle; ). meth WebApp wTitle me opath meth WebApp wHtml TAG('html', me wHead, me wBody) meth WebApp wHead HT{ TAG{'title', me wTitle}, TAG{'style', me 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:', me wFgColor, '; background-color:', me wBgColor, '; font-family:', me wFontFamily, '; font-size:', me wFontSize, '; font-weight:', me wFontWeight, '; } h1{ font-family: serif; font-size: 200%; font-weight: 300; } ',) jam meth WebApp wBody TAG('body', TAG('p', HT{me wTop}), TAG('p', HT{me wMid}), TAG('hr'), TAG('p', HT{me wBottom})) meth WebApp wTop TAG('h3', me wTitle) meth WebApp wMid HT('Hello World! This is WebApp:wMid. Override me.') meth WebApp wBottom HT( FOR(url,label: me wFootLinks) MAP( ' [', TAG('a'; 'href',url; label), '] ', Ht entity: 'nbsp', ) ) meth WebApp wFootLinks '/Top', 'Top'; '/Inspect.' ap: me 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= me 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( 'bad path:' err: 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. me. 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. me. 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. me. 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. me meth Foo y: y = a. me meth Foo z: z = a. me meth Foo one me x: 10 me y: 100 me z: 1000 cls Bar Foo vars Bar r s meth Bar x up x meth Bar r r meth Bar s s meth Bar one r = 1. s = 11. up one. me x: 2 * me x. me y: 2 * me y. me z: 2 * me z. me. meth Foo two x + y + z meth Bar two up 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. me. meth DemoLiveLife embargo embargo meth DemoLiveLife embargo: embargo= a. me. meth DemoLiveLife numX me numY * me scr width / me scr height $round meth DemoLiveLife numY 23 cls DemoLiveLifeSmall DemoLiveLife meth DemoLiveLifeSmall numY 11 cls DemoLiveLifeLarge DemoLiveLife meth DemoLiveLifeLarge numY 43 meth DemoLiveLife delX me scr width idiv: me numX meth DemoLiveLife delY me scr height idiv: me numY meth DemoLiveLife initState FOR(x: me numX)MAP( FOR(y: me numY)MAP( Num rand < 0.3 ) ). meth DemoLiveLife lifeStep dx,dy= me delX, me delY. dx2,dy2= dx idiv: 2, dy idiv: 2. rx,ry= dx2 - 1, dy2 - 1. nextState = FOR(x: me numX)MAP( FOR(y: me 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: me numX)DO{ FOR(y: me numY)DO{ IF{(state at: x) at: y} THEN{ xx = x * dx + dx2. yy = y * dy + dy2. me green rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry). } ELSE{ xx = x * dx + dx2. yy = y * dy + dy2. me black rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry). } } }. meth DemoLiveLife eventBlk FN( kind:ij: i,j= ij. x = i idiv: me delX. y = j idiv: me 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. me black color: 111. IF(state is: nil) THEN(state = me initState). FOR(i: 1000000)DO( me lifeStep. me post. ). ##################################### cls DemoLiveLifeRedBlue DemoLiveLife meth DemoLiveLifeRedBlue initState FOR{x: me numX}MAP{ FOR{y: me numY}MAP{ IF{ Num rand < 0.3 }THEN{ IF{x < me numX / 2} THEN{11} ELSE{101} }ELSE{ 0 }. } }. meth DemoLiveLifeRedBlue lifeStep dx,dy= me delX, me delY. dx2,dy2= dx idiv: 2, dy idiv: 2. rx,ry= dx2 - 1, dy2 - 1. pop = popR = popB = 0. nextState = FOR{x: me numX} MAP{ xx = x * dx + dx2. FOR{y: me 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 + ((me state at: i) at: j). }. }. "Notice cell x,y can count as a colored". "Simple neighbor count (no color)". bw = colored % 10. old= (me 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 = me black. 0); rc > bc, (pop=pop+1. popR=popR+1. clr = me red. 11); rc < bc, (pop=pop+1. popB=popB+1. clr = me blue. 101); 1 , (pop=pop+1. clr = me white. 1); }. clr rect: (xx - rx, yy - ry) to: (xx + rx, yy + ry). z. }. "next y" }. "next x" 'FINISHED lifeStep' say: (pop, popR, popB). me 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= me w1. ('Browse Class <', cn, '>') jam. meth BrowseClass wMid cn= me 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= me w1. c= Cls at: cn. vars= me 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= me w1, me wQuery at: 'method'. c= Cls at: cn. clsmeth= me 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= me w1, me w2. ('Browse Method <', cn, ' ', mn, '>') jam. meth BrowseMethod wMid cn,mn= me w1, me 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: (me 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 SnapshotWorld WebApp vars SnapshotWorld snap meth SnapshotWorld wTitle snap = ('w_zzz', (Sys secs % 999 $floor), '.txt')jam. snap. meth SnapshotWorld wMid x= File read: ('w_', Sys worldname, '.txt')jam lower. File write: snap value: x. HT('ok ', snap). 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; me notes: f}; TAG('p'); Ht bold: 'Local+Remote Worlds: '; Ht linkLabelPairs: FOR{f: both} MAP{('/BrowseBothWorld', f) join: '.'; f; me notes: f}; TAG('p'); Ht bold: 'Remote Worlds: '; Ht linkLabelPairs: FOR{f: onlyHub} MAP{('/BrowseRemoteWorld', f) join: '.'; f; me notes: f}; TAG('p'); }. cls BrowseLocalWorld WebApp meth BrowseLocalWorld wTitle wn=me w1. ('Local World:', wn) join meth BrowseLocalWorld wMid wn=me 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=me w1. ('Local+Remote World:', wn) join meth BrowseBothWorld wMid wn=me w1. cfg= Config load. mode= cfg d at: wn. CASE( mode )OF( 's' @ ( p= ('/WorldSyncUp', wn) join: '.', '(SyncUp)' ), 'd' @ ( p= ('/WorldSyncDown', wn) join: '.', '(SyncDown)' ), )ELSE( "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=me w1. ('Remote World:', wn) join meth BrowseRemoteWorld wMid wn=me 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=me w1. ('Share World:', wn) join. meth WorldShareUp wMid wn=me 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=me w1. ('SyncUp World:', wn) join. meth WorldSyncUp wMid wn=me 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=me w1. ('Fetch World:', wn) join. meth WorldFetch wMid wn=me 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: FN( 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= me w1. ('Create Subclass of', cn) join. meth FormCreateSubclass wMid cn= me 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= me w1. subcn= me wQuery at: 'subcls'. ('Created subclass', subcn, 'of', cn) join. meth SubmitCreateSubclass wMid cn= me w1. c= cls at: cn. subcn= me 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 GameFoo LiveApp vars GameFoo zoo cx cy wid hei meth gamefoo draw zoo = ( (-1,0); (0,0); (0,-1); (1,-1) ); ( (-1,0); (0,0); (0,1); (1,1) ); ( (-1,0); (0,0); (1,0); (2,0) ); ( (-1,0); (0,0); (0,1); (0,2) ); ( (1,0); (0,0); (0,1); (0,2) ); ( (-1,0); (0,0); (0,-1); (-1,-1) ); ( (-1,0); (0,0); (1,0); (0,1) ). n = num rand: (zoo len). wid = me scr width. hei = me scr height. cx,cy = 8,8. t = Sys secs. WHILE{1} DO{ me clear: 312. FOR{x,y: zoo at: n} DO{ me square: (cx+x,cy+y) ink: me green }. me showZoo. me post. IF{ t + 1 < Sys secs }THEN{ cy = cy + 1. t = Sys secs. } } meth GameFoo showZoo i= 0. FOR(shape: zoo) DO ( i=i+40. FOR(x,y: shape) DO ( me white rect: (x*10+i, y*10+i) to: (x*10+i+8, y*10+i+8). ). ). meth GameFoo square:ink: x,y= a. b rect: (30*x, 30*y) to: (30*x+25, 30*y+25). meth GameFoo eventBlk FN( kind: xy: me onEvent: kind at: xy) meth GameFoo onEvent:at: x,y= b say. "pad= x / wid * hei." IF{AND {(a==0) ; (y > hei/2) ; (x hei/2) ; (x>wid/2)}} THEN{ cx= cx + 1. 'cx is' say: cx. }. "move right" ############################ cls GamePong LiveApp vars GamePong n s e w ww hei wid bx by vx vy pad hit miss meth GamePong draw hei= me scr height. wid= me 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. me white fontSize: 48. "Determine fps by posting twice." bx, by = ww neg, ww neg. vx, vy = 0, 0. pad = hei / 2. me drawPong. me post. me drawPong. me post. me resetBall. WHILE{1} DO{ me moveBall. me drawPong. me 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 me clear: 213. me white rect: (0,0) to: (wid,ww). "top" me white rect: (0,s) to: (wid,hei). "bottom" me white rect: (0,n) to: (w,s). "left" w2 = ww / 2. me blue rect: (bx-w2, by-w2) to: (bx+w2, by+w2). me green rect: (e, pad - ww*1.8) to: (wid, pad + ww*1.8). fps = me scr fps. IF{fps is: nil $not}THEN{fps= fps fmt: '%.2f'}. me white text: (hit str, ':', miss str, ' (', fps, 'fps)')join sw: (2*ww, hei - 2*ww). meth GamePong moveBall fps= me 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. me resetBall. } }. meth GamePong eventBlk FN( kind: xy: me onEvent: kind at: xy) meth GamePong onEvent:at: x,y= b say. "pad= x / wid * hei." pad= y. ############################ cls GameTroids LiveApp vars GameTroids aa bb ship hei wid meth GameTroids newAster TroidsAster new $ink: me white $sz: 30 $init: me. meth GameTroids newBullet TroidsThing new $ink: me red $sz: 3 $ttl: 12.0 $init: me. meth GameTroids newShip TroidsThing new $ink: me green $sz: 10 $init: me. meth GameTroids draw hei= me scr height. wid= me scr width. me setup. WHILE{1}DO{me 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= me newAster $px: x $py: y $vx: Num rand * 2 - 1 $vy: Num rand * 2 - 1. aa ap: a. }. }. }. bb = Vec new. "bb ap: (me newBullet $px: wid/2 $py: hei/2 $vx: 1 $vy: 0.3)." me white fontSize: 24. ship= (me newShip $px: wid/2 $py: hei/2 $vx: 0 $vy: 0). meth GameTroids step me clear: COND( ship ttl < 0 @ 400, aa len < 1 @ 40, 1 @ 202, ). FOR{ast: aa} DO{ ast step: me. ast draw: me. }. FOR{bul: bb} DO{ bul step: me. bul draw: me. }. ship step: me. ship draw: me. "frames per sec" me white text: ((IF( me scr fps is: nil)THEN(0)ELSE(me scr fps)) fmt: '%.2f fps') str sw: (20,40). me 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: me 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 FN( kind: xy: IF{kind==0}THEN{me 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: (me 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. me. meth TroidsThing py: py= a. me. meth TroidsThing vx: vx= a. me. meth TroidsThing vy: vy= a. me. meth TroidsThing sz: sz= a. me. meth TroidsThing ink: ink= a. me. meth TroidsThing xyxy: xyxy= a. me. meth TroidsThing ttl: ttl= a. me. 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}. me. 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: up init: a. sixty= Num pi / 3. me xyxy: FOR{i:6}MAP{ r= 0.5 + 0.5 * Num rand. rad,theta= me sz * r, i * sixty. (rad * theta cos, rad * theta sin). }. me. meth TroidsAster draw: x1,y1= me xyxy at: -1. FOR{x2,y2: me xyxy} DO{ FOR{w: me ww}DO{ FOR{h: me hh}DO{ me ink line: (w + me px+x1, h + me py+y1) to: (w + me px+x2, h + me py+y2). }. }. x1,y1= x2,y2. } ############################## Fnord cls FnordApp App vars FnordApp gl meth FnordApp gl gl meth FnordApp handle:query: DICT( 'type', 'fnord'; 'value', me; ). meth FnordApp run: me say: 'FnordApp--run:'. gl = a. me init. while(1) do(me step). meth FnordApp init me gl ambient: 0.4 @ 0.4 @ 0.4. me gl diffuse: 0.9 @ 0.9 @ 0.9. me gl light: 100 @ 100 @ 100. meth FnordApp prePost: x = me gl ex. y = me gl ey. me gl light: x @ y @ 100. me gl eye: x @ y @ (x - y)abs * 3. me gl look: 100 - y @ 100 - x @ 0. meth FnordApp post: me prePost: a. me gl post: a. meth FnordApp step me post: me model. meth FnordApp model v1 = (). for(i: 6) do( for (j: 6) do( for (k: 6) do( v1 ap: ( Cube new $ pos: 20 + 10*i @ 20 + 10*j @ 10*k - 20 $ scale: 5 @ 3 @ 1 $ rot: i*10 @ j*10 @ k*10 $ color: 0.1+i/6 @ 0.1+j/6 @ 0.1+k/6 @ 0.9 ) ) ) ). v1 ap: ( Lines new: VEC(10@10@10, 90@10@10, 90@90@10, 10@90@10, 10@10@10, 50@50@50, 50@50@99) $color: 1@0@0 ). Group new vec: v1. cls FnordDebugRot FnordApp vars FnordDebugRot g green balls meth FnordDebugRot init up init. g = 0. green = 0@1@0@1. balls = Vec new. meth FnordDebugRot prePost: ex = me gl ex. ey = me gl ey. me gl up: 0 @ 1 @ 0. me gl light: 50 @ 50 @ 50. me gl eye: ex @ ey @ 20. me gl look: 50 @ 50 @ -100. me gl wires: Sys secs / 2 % 1. meth FnordDebugRot model Group new vec: VEC( FOR( i: 8 )MAP( x = 2*i. FOR( j: 8 )MAP( y = 2*j. FOR( k: 8 )MAP( z = 2*k. Cube new $ pos: x*10 @ y*10 @ z*-10 $ rot: x*10 @ y*10 @ z*10 $ scale: 8 @ 2 @ 0.5 $ color: 1 - x / 8 @ 1 - y / 8 @ 1 - z / 8 ) ) ) ) flat cls FnordCannon FnordApp vars FnordCannon g green balls meth FnordCannon init up init. g = 0. green = 0@1@0@1. balls = Vec new. meth FnordCannon model g = g + 1. ry= me gl ey - 50. rz= me gl ex - 50. IF( g % 200 == 0 )THEN( balls ap: (Cube new $ pos: 30 @ 20 @ 20 $ scale: 0.3 @ 0.3 @ 0.3 $ color: 1 @ 0 @ 0 @ 1 ). ). FOR( b : balls ) DO ( x,y,z= b pos. x = x + 0.02. b pos: x@y@z. ). Group new vec: VEC( Cube new $ pos: 15 @ 20 @ 20 $ scale: 10 @ 2 @ 2 $ color: green, Cube new $ pos: 25 @ 20 @ 20 $ scale: 8 @ 0.8 @ 0.8 $ color: green $ rot: 0 @ ry*2 @ rz*2, balls, ) flat meth FnordCannon prePost: x = me gl ex. y = me gl ey. me gl up: 0 @ 0 @ 1. me gl light: 25 @ -10 @ 25. me gl eye: 40 @ 0 @ 35. me gl look: 20 @ 25 @ 20. cls FnordCheeseDemo FnordApp vars FnordCheeseDemo t meth FnordCheeseDemo init up init. t= 0. meth FnordCheeseDemo model t= t + 2. Group new vec: for(i: 8) map( for (j: 8) map( for (k: 8) map( Cube new $ pos: 20 + 10*i @ 20 + 10*j @ 10*k - 20 $ scale: 5 @ 3 @ 1 $ rot: i*10+t @ j*10+2*t @ k*10+3*t $ color: 0.1+i/6 @ 0.1+j/6 @ 0.1+k/6 @ 0.9 ) ) ) flat. meth FnordCheeseDemo prePost: x = 25 + (t / 3 / 10) sin * 30. y = 25 + (t / 3 / 7) cos * 30. z = 25 + (t / 3 / 23) cos * 30. me gl light: x @ y @ z. me gl eye: x @ y @ z. me gl look: 30 @ 30 @ 30. cls FnordTwo FnordApp meth FnordTwo init up init. meth FnordTwo model v1 = (). for(i: 10) do( for (j: 10) do( v1 ap: ( Cube new $ rot: 10*i + 5 @ 10*j + 5 @ 0 $ pos: 10*i + 5 @ 10*j + 5 @ -1 $ scale: 8 @ 8 @ 1 $ color: i / 10 + 0.05 @ 0.2 @ i / 10 + 0.05 @ 1 ) ) ). v1 ap: ( Lines new: VEC(10@10@10, 90@10@10, 90@90@10, 10@90@10, 10@10@10, 50@50@50, 50@50@99) $color: 0@0@1 ). Group new vec: v1. cls FnordRandom FnordApp meth FnordRandom init up init. meth FnordRandom model v1 = (). for(i: 5) do( for (j: 5) do( for (k: 5) do( v1 ap: ( Cube new $ pos: 30 + (Num rand: 40) @ 30 + (Num rand: 40) @ (Num rand: 20) $ scale: 10 * Num rand @ 10 * Num rand @ 10 * Num rand $ rot: 180 * Num rand @ 180 * Num rand @ 180 * Num rand $ color: Num rand @ Num rand @ Num rand @ 1 ) ) ) ). v1 ap: ( Lines new: VEC(10@10@10, 90@10@10, 90@90@10, 10@90@10, 10@10@10, 50@50@50, 50@50@99) ). Group new vec: v1. cls FnordMotherShip FnordRandom vars FnordMotherShip model meth FnordMotherShip step "Only make the model once." IF(model equals: nil) THEN( model = me model. ). me post: model. cls RedPlane Usr vars RedPlane gl px py pz vx vy vz roll pitch yaw lasttime deltaT deltaTSum DeltaTCount lx ly lz lw tx ty tz tw ax ay az speed fric frac tvx tvy tvz ex ey throttle zoom # http://mathworld.wolfram.com/EulerAngles.html # phi about z (yaw); theta about new x (pitch); psi about new z (roll). # http://en.wikipedia.org/wiki/Flight_dynamics meth RedPlane init: gl = a. lasttime = Sys secs. px,py,pz = 25, 25, 1. vx,vy,vz = 0, 0, 0. roll,pitch,yaw = 0,0,0. deltaTSum = 0. deltaTCount = 0. ex = ey = 50. throttle = 0. zoom = 50. me. meth RedPlane step "me tweak." thistime = Sys secs. deltaT = (thistime - lasttime). "Yoke." IF(gl ey > 90) THEN(throttle = gl ex / 100) ELIF(gl ey < 10) THEN(zoom = gl ex) ELSE(ex,ey= gl ex - 50, gl ey - 50.). roll = ex / 1.5. pitch = ey / 1.5. yaw = yaw - deltaT * roll / 8. "Compute thrust in forward direction." m = Mat new rot: roll @ pitch @ yaw. tx,ty,tz,tw = m mulv: throttle @ 0 @ 0 @ 1. "Lift." kLift = throttle * 0.35 "0.55". speed= (vx, vy, vz) abs. lx,ly,lz,lw = m mulv: 0 @ 0 @ speed*kLift @ 1. "Gravity." kGrav = -0.60 "-0.5". "Total Acceleration (before drag)." ax,ay,az= tx+lx, ty+ly, tz+lz+kGrav. "Velocity." tvx,tvy,tvz= vx+ax, vy+ay, vz+az. "Drag." kDrag= 0.1. speed= (vx, vy, vz) abs. fric= speed * speed * kDrag. IF(fric > 1)THEN(fric= 1). frac= 1 - fric. vx,vy,vz= frac*tvx, frac*tvy, frac*tvz. px,py,pz = px+vx*deltaT, py+vy*deltaT, pz+vz*deltaT. "--IF(pz < 0)THEN(pz = 0). IF(pz > 51)THEN(pz = 50). --" IF(pz < 0)THEN(pz = 0). IF(pz > 50)THEN(pz = 50). IF(px < 0)THEN(px = px + 100). IF(px > 101)THEN(px = px - 100). IF(py < 0)THEN(py = py + 100). IF(py > 101)THEN(py = py - 100). " 'deltaT' say: deltaT. 'roll' say: ((Mat new rot: roll @ 0 @ 0)say mulv: (1@0@0@1)). 'pitch' say: ((Mat new rot: 0 @ pitch @ 0)say mulv: (1@0@0@1)). 'yaw' say: ((Mat new rot: 0 @ 0 @ yaw)say mulv: (1@0@0@1)). 'roll,pitch,yaw' say: (roll,pitch,yaw). 'tx,ty,tz' say: tx @ ty @ tz. 'lx,ly,lz' say: lx @ ly @ lz. 'ax,ay,az' say: ax @ ay @ az. 'vx,vy,vz' say: vx @ vy @ vz. 'px,py,pz' say: px @ py @ pz. " "--gl eye: px - 15*tx @ py - 15*ty @ pz - 15*tz + 5.--" gl eye: px - zoom @ py - zoom sqrt @ pz + zoom / 4 + 5. gl look: px @ py @ pz. gl up: 0 @ 0 @ 1. lasttime = thistime. meth RedPlane prototype Group new vec: VEC( "Fusalage along the X axis" Cube new $ scale: 1 @ 0.2 @ 0.2 $ color: 1 @ 0 @ 0 @ 1, "Wings along the Y axis" Cube new $ scale: 0.3 @ 0.8 @ 0.1 $ color: 0 @ 1 @ 0 @ 1 $ pos: 0.2 @ 0 @ 0.1, ). meth RedPlane macro:pr: bb = b value. Print new: ( FOR(x: bb flat) MAP( IF(x cls equals: Num) THEN(x fmt: '%.2f') ELSE(x str) ) join: ' ' ) meth RedPlane current deltaTSum = deltaTSum + deltaT. deltaTCount = deltaTCount + 1. w= gl wid. h= gl hei - 1. throtP = throttle * w. zoomP = zoom / 100 * w. Group new vec: VEC( me prototype $ pos: px @ py @ pz $ scale: 2 @ 2 @ 2 $ rot: roll @ pitch @ yaw , Lines new: (0@py@pz, 100@py@pz) $color: 0.2@0.2@0.2 , Lines new: (px@0@pz, px@100@pz) $color: 0.2@0.2@0.2 , Lines new: (px@py@0, px@py@100) $color: 0.2@0.2@0.2 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: 0 @ py @ pz $ color: 0@0.8@0 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: 100 @ py @ pz $ color: 0@0.8@0 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: px @ 0 @ pz $ color: 0@0.8@0 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: px @ 100 @ pz $ color: 0@0.8@0 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: px @ py @ 0 $ color: 0@0.8@0 , Cube new $ scale: 0.1 @ 0.1 @ 0.1 $ pos: px @ py @ 50 $ color: 0@0.8@0 , PR('pos:', px, py, pz, 'vel:', vx, vy, vz, 'speed:', speed) , PR('thrust:', tx, ty, tz, tw, 'lift:', lx, ly, lz, lw, 'acc:', ax, ay, az) , PR('fric:', fric, 'frac:', frac, 'tmp vel:', tvx, tvy, tvz) , PR('sw_fps: ', (1.0 / deltaT), (deltaTCount / deltaTSum), 'f:', deltaTCount, 'ms/f:', 1000 * deltaT) , PR('zoom:', zoom, 'throttle: ', throttle) , Seg new: (0@0, throtP @0, 0@1, w@1, 0@2, throtP @2,) , Rec new: (0@5, throtP @20) , Seg new: (0@h, zoomP@h, 0@h - 1, w@h - 1, 0@h - 2, zoomP@h - 2,) ) cls FnordFlight FnordApp vars FnordFlight plane meth FnordFlight init up init. plane= RedPlane new init: me gl. meth FnordFlight prePost: "up prePost: a." meth FnordFlight model m= me modelGround. plane step. Group new vec: VEC( m, plane current, ). meth FnordFlight modelGround greenish = 0 @ 0.6 @ 0. grayish = 0.3 @ 0.3 @ 0.3 @ 1. Group new vec: VEC( "Four runways." Cube new $ scale: 20 @ 5 @ 0.2 $ pos: 25 @ 25 @ 0 $ color: grayish, Cube new $ scale: 20 @ 5 @ 0.2 $ pos: 75 @ 75 @ 0 $ color: grayish, Cube new $ scale: 5 @ 20 @ 0.2 $ pos: 25 @ 75 @ 0 $ color: grayish, Cube new $ scale: 5 @ 20 @ 0.2 $ pos: 75 @ 25 @ 0 $ color: grayish, FOR(i: 10) MAP( FOR (j: 10) MAP( Cube new $ pos: 10*i + 5 @ 10*j + 5 @ -1 $ scale: 9 @ 9 @ 1 $ color: i / 10 + 0.05 @ 0.2 @ j / 10 + 0.05 @ 1 ) ), "Stars." "-- FOR(i: 5) MAP(i= i+1. FOR (j: 10) MAP(j= 10*j + 5. Cube new $ scale: 0.2 @ 0.2 @ 0.2 $ pos: 0 @ j @ i*10 $ color: 1 @ 0 @ 0 @ 1, Cube new $ scale: 0.2 @ 0.2 @ 0.2 $ pos: 100 @ j @ i*10 $ color: 0 @ 1 @ 0 @ 1, Cube new $ scale: 0.2 @ 0.2 @ 0.2 $ pos: j @ 0 @ i*10 $ color: 0 @ 0 @ 1 @ 1, Cube new $ scale: 0.2 @ 0.2 @ 0.2 $ pos: j @ 100 @ i*10 $ color: 1 @ 1 @ 1 @ 1, ) ), --" "Green grids - up and over the top" FOR (k: 10) MAP(k= 10*k + 5. Lines new: (k@0@0, k@0@50, k@100@50, k@100@0) $color: greenish, Lines new: (0@k@0, 0@k@50, 100@k@50, 100@k@0) $color: greenish, ), "Green grids - around the edge at various elevations." FOR (k: 5) MAP(k= 10*k + 10. Lines new: (0@0@k, 0@100@k, 100@100@k, 100@0@k, 0@0@k) $color: greenish, ), Seg new: (50@50, 100@50, 100@100, 150@100), )flat. cls DualFlight FnordFlight meth DualFlight handle:query: DICT( 'type', 'dual'; 'value', me; ). ############################ cls Act App vars Act wid hei path query meth Act wid: wid= a meth Act hei: hei= a meth Act wid wid meth Act hei hei ################################# # New Act framework begins here. ################################# cls DrawAct Act vars DrawAct scr red blue green white black stop meth DrawAct handle:query: path,query= a,b. DICT( 'type'@ 'live', 'value'@ FN( theScreen: me runApp: theScreen ), 'event'@ me eventBlk). meth DrawAct eventBlk FN( event: xy: me on: event at: xy) meth DrawAct on:at: me meth DrawAct stop: a stop= a meth DrawAct scr scr meth DrawAct wid wid meth DrawAct hei hei meth DrawAct red red meth DrawAct green green meth DrawAct blue blue meth DrawAct white white meth DrawAct black black meth DrawAct newInk: scr newInk: a meth DrawAct post scr post meth DrawAct clear: scr clear: a meth DrawAct runApp: scr= a. wid= scr width. hei= scr height. stop= 0. red= scr newInk: 900. green= scr newInk: 90. blue= scr newInk: 9. white= scr newInk: 999. black= scr newInk: 0. me init. while(stop not) DO( me step. me post. ). me. meth DrawAct init me. meth DrawAct step me say: 'Drawing a red X on blue bg. You should subclass DrawAct or define .'. me clear: 3. me red line: 0@0 to: wid - 1@hei - 1. me red line: wid - 1@0 to: 0@hei - 1. me stop: 1. me. ############################ cls PongGame DrawAct vars PongGame n s e w ww bx by vx vy pad hit miss meth PongGame init up init. 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. me white fontSize: 48. "Determine fps by posting twice." bx, by = ww neg, ww neg. vx, vy = 0, 0. pad = hei / 2. FOR(2)DO( me resetBall. me drawPong. me post. ). me resetBall. meth PongGame step me moveBall. me drawPong. vx = vx * 1.001. meth PongGame resetBall bx, by = 2 * ww, ww + (Num rand: hei - 2*ww). "ball position." vx, vy = 8, 4. "ball velocity." meth PongGame drawPong me clear: 213. me white rect: (0,0) to: (wid,ww). "top" me white rect: (0,s) to: (wid,hei). "bottom" me white rect: (0,n) to: (w,s). "left" w2 = ww / 2. me blue rect: (bx-w2, by-w2) to: (bx+w2, by+w2). me green rect: (e, pad - ww*1.8) to: (wid, pad + ww*1.8). fps = me scr fps. IF{fps is: nil $not}THEN{fps= fps fmt: '%.2f'}. me white text: (hit str, ':', miss str, ' (', fps, 'fps)')join sw: (2*ww, hei - 2*ww). meth PongGame moveBall fps= me 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. me resetBall. } }. meth PongGame on:at: x,y= b say. "pad= x / wid * hei." pad= y. ############################ cls GrafAct Act vars GrafAct gl graf stop meth GrafAct eventBlk FN( event: xy: me on: event at: xy) meth GrafAct handle:query: DICT( 'type', 'fnord'; 'value', me; ). # TODO: runApp: meth GrafAct run: me say: 'GrafAct--run:' @ a. gl = a. me init. WHILE(stop not) DO( me step. me prePost: graf. me post: graf. ). meth GrafAct gl gl meth GrafAct init me gl ambient: 0.4 @ 0.4 @ 0.4. me gl diffuse: 0.9 @ 0.9 @ 0.9. me gl light: 100 @ 100 @ 100. meth GrafAct prePost: x = me gl ex. y = me gl ey. me gl light: x @ y @ 100. me gl eye: x @ y @ (x - y)abs * 3. me gl look: 100 - y @ 100 - x @ 0. meth GrafAct post: me prePost: a. me gl post: a. ############################ cls BlocksDemo GrafAct meth BlocksDemo step graf= me model. "TODO" "stop= 1." meth BlocksDemo model v1 = (). for(i: 6) do( for (j: 6) do( for (k: 6) do( v1 ap: ( Cube new $ pos: 20 + 10*i @ 20 + 10*j @ 10*k - 20 $ scale: 5 @ 3 @ 1 $ rot: i*10 @ j*10 @ k*10 $ color: 0.1+i/6 @ 0.1+j/6 @ 0.1+k/6 @ 0.9 ) ) ) ). v1 ap: ( Lines new: VEC(10@10@10, 90@10@10, 90@90@10, 10@90@10, 10@10@10, 50@50@50, 50@50@99) $color: 1@0@0 ). Group new vec: v1. ############################ cls VuDemo Act meth VuDemo handle:query: DICT( 'type', 'usr'; 'value', me; ) ##END