Paste: ftest

USING: io io.files io.timeouts io.launcher concurrency.messaging threads printf random kernel continuations calendar prettyprint math math.ranges math.functions locals io.encodings.ascii ;
IN: ftest

DEFER: generate
DEFER: 2exec>files


: read-loop ( controller -- )
  readln dup
  [
    over f send
    write nl
    read-loop
  ] [
    drop t send
  ] if
;

: enter-read-loop ( controller in out-file -- )
  <file-writer> [
    [ dup read-loop ] with-streams
  ] ignore-errors
  t swap send ;
  

: enter-generate ( w-control out1 out2 -- )
  dup [ generate ] ignore-errors
  t send ;
  
: w-control-loop ( controller generator -- )
  receive [
    stop
    t send
  ] [
    dup resume
    w-control-loop
  ] if ;

: enter-write-loop ( out1 out2 -- )
#!  [ generate ] cocreate write-loop ;
  receive [
    self -rot [ enter-generate ] 3curry "generator" spawn
    w-control-loop
  ] unless ;

  
: controller-loop ( writer -- )
  : wait ( -- )
    [
      100 milliseconds receive-timeout
      [ wait ] unless
    ]
  ;

  [ wait t ] [ drop f ] recover
  
  [ dup f send
    controller-loop ] unless
;


: read-commands ( -- cmd1 cmd2 )
  "cmds" ascii file-lines dup first swap second ;

: similar? ( file1 file2 -- similar? )
  [ "diff %s %s" sprintf try-process t ] [ f ] recover ;

: pass ( cmd1 cmd2 i -- )
  3dup 0 = [ 2drop ] [
    2exec>files similar? [ 1 - pass ] when
  ] if ;

: main ( -- )
  "hello" .
  read-commands 100 pass ;


#! : create-process ( cmd -- )  ascii <process-stream> ;
  
: start-reader ( in out-file -- )
  self -rot [ enter-read-loop ] 3curry spawn ;

: out-file-names ( -- file1 file2 )
  1 2 [ "/tmp/diffproc/%d" sprintf ] 2bi@ ;
  
: start-readers ( in1 in2 -- thread1 thread2 )
  out-file-names swapd [ start-reader ] 2bi@ ;

#! : create-writer ( out1 out2 -- )
#!  [ enter-write-loop ] 2curry spawn ;

: create-threads ( cmd1 cmd2 -- reader1 reader2 writer )
  [ ascii <process-stream> ] bi@ 2dup
    [ enter-write-loop ] "w-control" spawn
    -rot start-readers rot
;


: await-termination ( -- )
  receive receive 2drop ;


: terminate-threads ( reader1 reader2 writer -- )
  [ t send ] tri@ await-termination ;


: 2exec>files ( cmd1 cmd2 -- file1 file2 )
  create-threads
  dup controller-loop
  terminate-threads
;


#! ##### BUSINESS LOGIC #####

: random-int ( -- val ) 4096 random 2048 - ;

: random-real ( -- val ) 0.0 4096.0 [a,b] random 2048 - ;

: floor1 ( n -- n ) 10 * floor 10 / ;


: pb ( val out1 out2 -- )
  pick swap [ write nl ] bi@
  suspend ;

:: pbl ( out1 out2 -- )
  [| val | val out1 out2 pb ] ;


: interact-mort ( out1 out2 -- )
  2dup pbl
  
  :: three ( lambda -- )
    lambda [ random-int swap keep ] bi@
    2dup [ 0 <= ] bi@ or [
      2dup [ 0 <= ] bi@ and [
        2drop lambda three
      ] [
        random-real lambda keep
        0 <= -rot [ 0 <= ] bi@ and or [ lambda three ] when
      ] if
    ] when
    2drop
  ;

  : interact-menu-mort ( lambda -- )
    10 random swap keep
    dup 1 >= swap 8 < and
      [ interact-menu-mort ] [ "AFTER_MORT" . ] if
  ;
  
  random-real swap keep
  0 <= [ interact-mort ] [ three interact-menu-mort ] if
;


: interact-invest ( out1 out2 -- )
  pbl
  :: outval ( lambda quot -- )
    quot call lambda keep
    0 <= [ lambda outval ] when ;

  dup [ random-int ] [ outval ] 2bi@
  [ random-real ] outval

  :: interact-menu-invest ( lambda -- )
    9 random swap keep
    dup 1 >= swap 7 < and
    [ lambda interact-menu-invest ] [ "AFTER INVEST" . ] if
  
  interact-menu-invest
;


: generate ( out1 out2 -- )
#!  : yield *coyield drop ;
  2dup pbl
  5 random 1 - swap keep
  dup dup dup 0 <= swap 2 > or [
    drop generate
  ] [
    1 = [ interact-mort ] [ interact-invest ] if
  ]
;

MAIN: main ;