about summary refs log blame commit diff stats
path: root/browse-slack/main.mu
blob: 2e3eca04f3d858e6e9cafd5c1465aeb9078051fc (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11










                                           
               







                              
                              








                                    
                          
                    
                            




                                                                                  


                                                                              
                                                                                                          

                                                

                                                                                     
































                                                                                           
                                                                                                                     








                                                                          


                                   
                                           

                                                                                                          
                       


















                                                                 



                                     


                                                                                                  

























                                               


                                                              









                                                          


                































































                                                                                    


                                                                                                                   






                                         
 
 
                                






                                                                      
                                          


















                                   








                                                                     
                                         


















                                   
type channel {
  id: (handle array byte)
  name: (handle array byte)
  posts: (handle array int)  # item indices
  newest-post-index: int
}

type user {
  id: (handle array byte)
  name: (handle array byte)
  real-name: (handle array byte)
  avatar: image
}

type item {
  id: (handle array byte)
  channel: (handle array byte)
  by: int  # user index
  text: (handle array byte)
  parent: int  # item index
  comments: (handle array int)
}

# globals:
#   users: (handle array user)
#   channels: (handle array channel)
#   items: (handle array item)
#
# flows:
#   channel -> posts
#   user -> posts|comments
#   post -> comments
#   comment -> post|comments
#   keywords -> posts|comments

# I try to put all the static buffer sizes in this function.
fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
  # load entire disk contents to a single enormous stream
  var s-h: (handle stream byte)  # the stream is too large to put on the stack
  var s-ah/eax: (addr handle stream byte) <- address s-h
  populate-stream s-ah, 0x4000000
  draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "loading data disk..", 3/fg 0/bg
  var _s/eax: (addr stream byte) <- lookup *s-ah
  var s/ebx: (addr stream byte) <- copy _s
  load-sectors data-disk, 0/lba, 0x400/sectors, s  # large enough for test_data
#?   load-sectors data-disk, 0/lba, 0x20000/sectors, s  # largest size tested; _slow_
  draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "done", 3/fg 0/bg
  # parse global data structures out of the stream
  var users-h: (handle array user)
  var users-ah/eax: (addr handle array user) <- address users-h
  populate users-ah, 0x800
  var _users/eax: (addr array user) <- lookup *users-ah
  var users/edi: (addr array user) <- copy _users
  var channels-h: (handle array channel)
  var channels-ah/eax: (addr handle array channel) <- address channels-h
  populate channels-ah, 0x20
  var _channels/eax: (addr array channel) <- lookup *channels-ah
  var channels/esi: (addr array channel) <- copy _channels
  var items-h: (handle array item)
  var items-ah/eax: (addr handle array item) <- address items-h
  populate items-ah, 0x10000
  var _items/eax: (addr array item) <- lookup *items-ah
  var items/edx: (addr array item) <- copy _items
  parse s, users, channels, items
  # render
  var env-storage: environment
  var env/ebx: (addr environment) <- address env-storage
  {
    render-environment env, users, channels, items
    {
      var key/eax: byte <- read-key keyboard
      compare key, 0
      loop-if-=
      update-environment env, key
    }
    loop
  }
}

fn parse in: (addr stream byte), users: (addr array user), channels: (addr array channel), items: (addr array item) {
  # 'in' consists of a long, flat sequence of records surrounded by parens
  var record-storage: (stream byte 0x18000)
  var record/ecx: (addr stream byte) <- address record-storage
  var user-idx/edx: int <- copy 0
  var item-idx/ebx: int <- copy 0
  {
    var done?/eax: boolean <- stream-empty? in
    compare done?, 0/false
    break-if-!=
    var c/eax: byte <- peek-byte in
    compare c, 0
    break-if-=
    set-cursor-position 0/screen, 0x20 0x20
    draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, user-idx, 3/fg 0/bg
    draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, item-idx, 4/fg 0/bg
    clear-stream record
    parse-record in, record
    var user?/eax: boolean <- user-record? record
    {
      compare user?, 0/false
      break-if-=
      parse-user record, users, user-idx
      user-idx <- increment
    }
    {
      compare user?, 0/false
      break-if-!=
      parse-item record, channels, items, item-idx
      item-idx <- increment
    }
    loop
  }
}

fn parse-record in: (addr stream byte), out: (addr stream byte) {
  var paren/eax: byte <- read-byte in
  compare paren, 0x28/open-paren
  {
    break-if-=
    set-cursor-position 0/screen, 0x20 0x10
    var c/eax: int <- copy paren
    draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen c, 5/fg 0/bg
    abort "parse-record: ("
  }
  var paren-int/eax: int <- copy paren
  append-byte out, paren-int
  {
    {
      var eof?/eax: boolean <- stream-empty? in
      compare eof?, 0/false
      break-if-=
      abort "parse-record: truncated"
    }
    var c/eax: byte <- read-byte in
    {
      var c-int/eax: int <- copy c
      append-byte out, c-int
    }
    compare c, 0x29/close-paren
    break-if-=
    compare c, 0x22/double-quote
    {
      break-if-!=
      slurp-json-string in, out
    }
    loop
  }
  skip-chars-matching-whitespace in
}

fn user-record? record: (addr stream byte) -> _/eax: boolean {
  rewind-stream record
  var c/eax: byte <- read-byte record  # skip paren
  var c/eax: byte <- read-byte record  # skip double quote
  var c/eax: byte <- read-byte record
  compare c, 0x55/U
  {
    break-if-!=
    return 1/true
  }
  rewind-stream record
  return 0/false
}

fn parse-user record: (addr stream byte), _users: (addr array user), user-idx: int {
  var users/esi: (addr array user) <- copy _users
  var offset/eax: (offset user) <- compute-offset users, user-idx
  var user/esi: (addr user) <- index users, offset
  #
  var s-storage: (stream byte 0x40)
  var s/ecx: (addr stream byte) <- address s-storage
  #
  rewind-stream record
  var paren/eax: byte <- read-byte record
  compare paren, 0x28/open-paren
  {
    break-if-=
    abort "parse-user: ("
  }
  # user id
  skip-chars-matching-whitespace record
  var double-quote/eax: byte <- read-byte record
  compare double-quote, 0x22/double-quote
  {
    break-if-=
    abort "parse-user: id"
  }
  next-json-string record, s
  var dest/eax: (addr handle array byte) <- get user, id
  stream-to-array s, dest
  # user name
  skip-chars-matching-whitespace record
  var double-quote/eax: byte <- read-byte record
  compare double-quote, 0x22/double-quote
  {
    break-if-=
    abort "parse-user: name"
  }
  next-json-string record, s
  var dest/eax: (addr handle array byte) <- get user, name
  stream-to-array s, dest
  # real name
  skip-chars-matching-whitespace record
  var double-quote/eax: byte <- read-byte record
  compare double-quote, 0x22/double-quote
  {
    break-if-=
    abort "parse-user: real-name"
  }
  next-json-string record, s
  var dest/eax: (addr handle array byte) <- get user, real-name
  stream-to-array s, dest
  # avatar
  skip-chars-matching-whitespace record
  var open-bracket/eax: byte <- read-byte record
  compare open-bracket, 0x5b/open-bracket
  {
    break-if-=
    abort "parse-user: avatar"
  }
  skip-chars-matching-whitespace record
  var c/eax: byte <- peek-byte record
  {
    compare c, 0x5d/close-bracket
    break-if-=
    var dest/eax: (addr image) <- get user, avatar
    initialize-image dest, record
  }
}

fn parse-item record: (addr stream byte), channels: (addr array channel), items: (addr array item), item-idx: int {
  rewind-stream record
  var paren/eax: byte <- read-byte record
  compare paren, 0x28/open-paren
  {
    break-if-=
    abort "parse-item: ("
  }
}

# includes trailing double quote
fn slurp-json-string in: (addr stream byte), out: (addr stream byte) {
  # open quote is already slurped
  {
    {
      var eof?/eax: boolean <- stream-empty? in
      compare eof?, 0/false
      break-if-=
      abort "slurp-json-string: truncated"
    }
    var c/eax: byte <- read-byte in
    {
      var c-int/eax: int <- copy c
      append-byte out, c-int
    }
    compare c, 0x22/double-quote
    break-if-=
    compare c, 0x5c/backslash
    {
      break-if-!=
      # read next byte raw
      c <- read-byte in
      var c-int/eax: int <- copy c
      append-byte out, c-int
    }
    loop
  }
}

# drops trailing double quote
fn next-json-string in: (addr stream byte), out: (addr stream byte) {
  # open quote is already read
  {
    {
      var eof?/eax: boolean <- stream-empty? in
      compare eof?, 0/false
      break-if-=
      abort "next-json-string: truncated"
    }
    var c/eax: byte <- read-byte in
    compare c, 0x22/double-quote
    break-if-=
    {
      var c-int/eax: int <- copy c
      append-byte out, c-int
    }
    compare c, 0x5c/backslash
    {
      break-if-!=
      # read next byte raw
      c <- read-byte in
      var c-int/eax: int <- copy c
      append-byte out, c-int
    }
    loop
  }
}
nv">pair-address <- get-address result:move-address/deref from:offset) (dest:integer-address <- get-address f:integer-integer-pair-address/deref 0:offset) (dest:integer-address/deref <- copy from-file:integer) (dest:integer-address <- get-address f:integer-integer-pair-address/deref 1:offset) (dest:integer-address/deref <- copy from-rank:integer) (t0:integer-integer-pair-address <- get-address result:move-address/deref to:offset) (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 0:offset) (dest:integer-address/deref <- copy to-file:integer) (dest:integer-address <- get-address t0:integer-integer-pair-address/deref 1:offset) (dest:integer-address/deref <- copy to-rank:integer) (reply result:move-address) ]) ; todo: assumes stdin is always at raw address 1 (function read-file [ (default-space:space-address <- new space:literal 30:literal) (stdin:channel-address <- next-input) (screen:terminal-address <- next-input) (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) (a:character <- copy ((#\a literal))) (file-base:integer <- character-to-integer a:character) (c:character <- maybe-coerce x:tagged-value character:literal) { begin (quit:boolean <- equal c:character ((#\q literal))) (break-unless quit:boolean) (reply nil:literal) } (file:integer <- character-to-integer c:character) (file:integer <- subtract file:integer file-base:integer) ; assert('a' <= from-file <= 'h') (above-min:boolean <- greater-or-equal file:integer 0:literal) (assert above-min:boolean (("file too low" literal))) (below-max:boolean <- lesser-or-equal file:integer 7:literal) (assert below-max:boolean (("file too high" literal))) (reply file:integer) ]) (function read-rank [ (default-space:space-address <- new space:literal 30:literal) (stdin:channel-address <- next-input) (screen:terminal-address <- next-input) (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) (c:character <- maybe-coerce x:tagged-value character:literal) { begin (quit:boolean <- equal c:character ((#\q literal))) (break-unless quit:boolean) (reply nil:literal) } (rank:integer <- character-to-integer c:character) (one:character <- copy ((#\1 literal))) (rank-base:integer <- character-to-integer one:character) (rank:integer <- subtract rank:integer rank-base:integer) ; assert('1' <= rank <= '8') (above-min:boolean <- greater-or-equal rank:integer 0:literal) (assert above-min:boolean (("rank too low" literal))) (below-max:boolean <- lesser-or-equal rank:integer 7:literal) (assert below-max:boolean (("rank too high" literal))) (reply rank:integer) ]) (function expect-stdin [ (default-space:space-address <- new space:literal 30:literal) (stdin:channel-address <- next-input) (screen:terminal-address <- next-input) ; slurp hyphen (x:tagged-value stdin:channel-address/deref <- read stdin:channel-address) (c:character <- maybe-coerce x:tagged-value character:literal) (expected:character <- next-input) (match?:boolean <- equal c:character expected:character) (assert match?:boolean (("expected character not found" literal))) ]) (function make-move [ (default-space:space-address <- new space:literal 30:literal) (b:board-address <- next-input) (m:move-address <- next-input) (x:integer-integer-pair <- get m:move-address/deref from:offset) (from-file:integer <- get x:integer-integer-pair 0:offset) (from-rank:integer <- get x:integer-integer-pair 1:offset) (f:file-address <- index b:board-address/deref from-file:integer) (src:square-address <- index-address f:file-address/deref from-rank:integer) (x:integer-integer-pair <- get m:move-address/deref to:offset) (to-file:integer <- get x:integer-integer-pair 0:offset) (to-rank:integer <- get x:integer-integer-pair 1:offset) (f:file-address <- index b:board-address/deref to-file:integer) (dest:square-address <- index-address f:file-address/deref to-rank:integer) (dest:square-address/deref <- copy src:square-address/deref) (src:square-address/deref <- copy ((#\_ literal))) (reply b:board-address) ]) (function main [ (default-space:space-address <- new space:literal 30:literal) (initial-position:list-address <- init-list ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal)) ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal)) ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal)) ((#\Q literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\q literal)) ((#\K literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\k literal)) ((#\B literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\b literal)) ((#\N literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\n literal)) ((#\R literal)) ((#\P literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\_ literal)) ((#\p literal)) ((#\r literal))) (b:board-address <- init-board initial-position:list-address) (cursor-mode) ; hook up stdin (stdin:channel-address <- init-channel 1:literal) (fork-helper send-keys-to-stdin:fn nil:literal/globals nil:literal/limit nil:literal/keyboard stdin:channel-address) { begin ; print any stray characters from keyboard *before* clearing screen (clear-screen nil:literal/terminal) (print-primitive-to-host (("Stupid text-mode chessboard. White pieces in uppercase; black pieces in lowercase. No checking for legal moves." literal))) (cursor-to-next-line nil:literal/terminal) (cursor-to-next-line nil:literal/terminal) (print-board nil:literal/terminal b:board-address) (cursor-to-next-line nil:literal/terminal) (print-primitive-to-host (("Type in your move as <from square>-<to square>. For example: 'a2-a4'. Currently very unforgiving of typos; exactly five letters, no <Enter>, no uppercase." literal))) (cursor-to-next-line nil:literal/terminal) (print-primitive-to-host (("Hit 'q' to exit." literal))) (cursor-to-next-line nil:literal/terminal) (print-primitive-to-host (("move: " literal))) (m:move-address <- read-move stdin:channel-address nil:literal/terminal) (break-unless m:move-address) (b:board-address <- make-move b:board-address m:move-address) (loop) } (cursor-to-next-line) ]) ; todo: ; backspace, ctrl-u