urbit/base/ape/octo/core.hook
2015-05-27 20:48:25 -07:00

212 lines
13 KiB
Plaintext

:: :: ::
:::: /hook/core/acto/ape :: :: dependencies
:: :: ::
/? 310 :: arvo version
/- *sole, *octo :: structures
/+ sole, octo :: libraries
:: :: ::
:::: :: :: server
!: :: ::
=> |% :: arvo structures
++ axle ,[eye=face rem=(unit ship) gam=game] :: agent state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
[%peer wire dock path] :: subscribe
[%poke wire dock pear] :: send move
[%pull wire dock ~] :: unsubscribe
== ::
++ face (map bone sole-share) :: console state
++ lime $% [%sole-effect sole-effect] :: :sole update
[%octo-update (each game tape)] :: :octo update
== ::
++ move (pair bone card) :: cause and action
++ pear ,[%octo-move point] :: outgoing move
-- ::
=> |% :: historical state
++ axon $%([%1 axle] [%0 axle-0]) ::
++ axle-0 ,[eye=face gam=game-0] ::
++ game-0 ,[who=? box=board boo=board] ::
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ comb (pick come ;~(pfix sig (punt fed:ag))) :: all command input
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) comb)) :: with wait mode
-- ::
|_ [hid=bowl moz=(list move) %1 axle] :: per agent
++ ce :: per client
|_ from ::
:: :: ::
:::: :: :: common logic
:: :: ::
++ abet [(flop moz) +>(moz ~)] :: resolve core
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ echo |= [pre=path fun=$+(_. _+>)] :: broadcast
=+ [all=(pale hid (prix pre)) los=+>+<] ::
|- ^+ +>.^$ ?~ all +>.^$(+< los) ::
=> .(ost p.i.all, src p.q.i.all) ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ emit |=(lime (dish %diff +<)) :: publish
:: :: ::
:::: :: :: custom logic
:: :: ::
++ fail ?:(soul (fect %bel ~) ~|(%invalid-move !!)) :: user error
++ fect |=(sole-effect (emit %sole-effect +<)) :: update console
++ fact |=((each game tape) (emit %octo-update +<)) :: update partner
++ flap |= [net=$+(_. _+>) con=$+(_. _+>)] :: update all
=. +> (echo /octo net) (echo /sole con) ::
++ here ~(. go src gam) :: game core
++ kick |= a=point :: try move
=^ dud gam ~(m at:here a) ::
?.(dud fail ?~(rem kind (send a))) ::
++ kind =+ res:here :: move result
?~(- wild (word:wild(gam new:here) ->)) ::
++ plan |= (unit ship) :: link/unlink
?~ +< wild:stop(gam *game) ::
?^(rem fail (link u.+<)) ::
++ plot |= (each point (unit ship)) :: apply command
?-(+<- & (kick +<+), | (plan +<+)) ::
++ like |=(ship |*(* [/octo [+>+< %octo] +<])) :: message to friend
++ link |= ship :: subscribe to friend
(dish(rem `+<) peer/((like +<) /octo)) ::
++ lose ?^(rem . tame(gam out:here)) :: lost subscriber
++ meet ?^(rem . tame(gam inn:here)) :: gained subscriber
++ prom (fect %pro %& %octo stat) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn lose(eye (~(del by eye) ost)) :: console unsubscribe
++ seen meet(eye (~(put by eye) ost *sole-share)) :: console subscribe
++ send |= a=point ::
(dish poke/((like +.rem) %octo-move +<)) ::
++ show (fect %mor rend) :: update board
++ soul =(%sole -:q:(~(got by sup.hid) ost)) :: is console
++ stat ^- tape =+ ike=~[(icon who.gam)] :: status line
%- zing :~ ::
?~(rem "" "@{(scow %p u.rem)}") ::
?~(aud.gam "" vew:here) ::
?: !ept:here " ({ike}'s turn) " ::
": {ike} (row/col): " ::
== ::
++ stop ?~(rem . (dish pull/((like +.rem) ~))) ::
++ tame %+ flap |=(_. (fact:+< &/gam)) :: mild update
|=(_. prom:+<) ::
++ wild %+ flap |=(_. (fact:+< &/gam)) :: full update
|=(_. prom:show:+<) ::
++ word |= txt=tape %+ flap :: game message
|=(_+> (fact:+< |/txt)) ::
|=(_+> (fect:+< txt/txt)) ::
:: :: ::
:::: :: :: console UI
:: :: ::
++ work :: conslle action
|= act=sole-action ::
=+ say=(~(got by eye) ost) ::
|^ ?:(?=(%det -.act) (delt +.act) dive) ::
++ abet ..work(eye (~(put by eye) ost say)) :: resolve
++ cusp (cope !ept:here) :: parsing rule
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt comb)) :: apply command line
?~(- fail ?~(-> show (plot:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
-- ::
:: :: ::
:::: :: :: arvo handlers
:: :: ::
++ reap-octo :: linked to friend
|= [* saw=(unit)] ::
?~ saw (word "linked to {<src>}") ::
(word(rem ~) "blocked by {<src>}") ::
:: ::
++ coup-octo :: move acknowledge
|= [* saw=(unit)] ::
?~(saw +> (word "move failed")) ::
:: ::
++ diff-octo-update :: friend update
|= [way=wire mex=(each game tape)] ::
?- -.mex ::
| (word p.mex) ::
& ?:(=(gam p.mex) +> wild(gam p.mex)) ::
== ::
:: ::
++ peer-octo :: urbit peer
|= pax=path ::
tame:meet ::
:: ::
++ peer-sole :: console subscribe
|= pax=path ::
prom:show:seen ::
:: ::
++ poke-sole-action :: console input
|= act=sole-action ::
(work act) ::
:: ::
++ poke-octo-move ::
|= point ::
wild:(kick +<) ::
:: ::
++ prep ::
|= [old=(unit ,[(list move) axon])] :: initialize
?-
=< abet ?~ old +> ::
=< (park %2 ~) ::
?- -.+>.old ::
%1 +>(+<+ u.old) ::
%0 !! ::
== ::
+> ::
::
++ pull-octo :: unsubscribe
|= pax=path ::
^+ +>
lose ::
::
++ pull-sole :: disconnect console
|= pax=path ::
^+ +>
sawn
::
++ quit-octo :: unlinked by friend
|= way=wire
^+ +>
?~(rem +> (link +.rem)) ::
-- ::
:: :: ::
:::: :: :: handlers
:: :: ::
++ coup-octo :: move acknowledge
|= [then saw=(unit tang)] ::
abet:(~(coup-octo ce ost src) way saw) ::
++ diff-octo-update :: friend update
|= [then mex=(each game tape)] ::
abet:(~(diff-octo-update ce ost src) way mex) ::
++ peer-octo :: urbit peer
|= [from path] ::
abet:(~(peer-octo ce +<-) +<+) ::
++ peer-sole :: console subscribe
|= [from path] ::
abet:(~(peer-sole ce +<-) +<+) ::
++ poke-sole-action :: console input
|= [from sole-action] ::
abet:(~(poke-sole-action ce +<-) +<+) ::
++ poke-octo-move ::
|= [from point] ::
abet:(~(poke-octo-move ce +<-) +<+) ::
++ prep |= [from (unit ,[(list move) axon])] :: initialize
abet:(~(prep ce +<-) +<+) ::
++ pull-octo :: unsubscribe
|= [from path] ::
abet:(~(pull-octo ce +<-) +<+) ::
++ pull-sole :: disconnect console
|= [from path] ::
abet:(~(pull-sole ce +<-) +<+) ::
++ quit-octo :: unlinked by friend
|= then ::
abet:(~(quit-octo ce ost src) way) ::
++ reap-octo :: linked to friend
|= [then saw=(unit tang)] ::
abet:(~(reap-octo ce ost src) way saw) ::
--