to download
compile-procs parse filetostring file-field
end

to compile-procs :list
setstatus "|Compiling...|
let [code compile-fcns :list]
monoff
if not brick-check [stop]
send 4 wait 3
setstatus "|Downloading...|
download-code :code
set-pointer :remotes
dolist [i :remotelist][ignore compile-line :i]
dolist [i :remotelist][write-remote :i]
setstatus se count :procs "bytes
monon
end

to write-remote :list
if empty? :list [write-empty-remote stop]
let [string (word :list)
     code compile-line :list]
put-byte count :string
dotimes [i count :string][put-byte ascii item :i + 1 :string]
put-byte count :code
dolist [i :code][put-byte :i]
end

to write-empty-remote
dolist [i [3 45 45 45 1 20]][put-byte :i]
end

to command-center-cr :line
if empty? :line [stop]
if (first :line) = "! 
   [carefully bf :line [print errormessage] stop]
setstatus "
;print compile-line :line
;stop
monoff
if not brick-check [stop]
let [code compile-line :line]
run-code :code
monon
end


to remotelist
output [field1 field2 field3 field4 field5 
            field6 field7]
end



to brick-check
repeat 4 [send 5 wait 1 if .recc = 6 [output true]]
print [Handy Board not connected.] 
setstatus "
output false
end





to monitor
let [c 0]
brick-cc,
ifelse receive? 
    [make "c .recc
       if legible? :c [insert char :c]]
    [wait60 3]
end

to ticktask
if not :monon [stop]
let [c "]
repeat 100 [
make "c .recc
if :c = -1 [stop]
if :c = 13 [monprint " stop]
if :c < 32 [monprint (word "< :c ">) stop]
moninsert char :c]
end

to legible? :c
  if :c > 127 [output false]
  if :c > 31 [output true]
  output :c = 13
end

to monon
make "monon true
end

to monoff
make "monon false
wait 2
end

;-------- Communications---------

to set-pointer :n
send 0
send int :n / 256
send remainder :n 256
end

to get-byte 
.send 1
let [c 0]
loop [make "c .recc if :c > -1 [output :c]]
end

to get-word
output sum lsl get-byte 8 get-byte
end

to put-byte :n
.send 2
.send :n 
end

to run-code :list
set-pointer :command-line
dolist [i :list][put-byte :i]
set-pointer :command-line
.send 3
end

to download-code :list
set-pointer :procs
dolist [i :list][put-byte :i]
end


-------------------------
to compile-fcns :code
dolist [i :plist-names] [erplist :i]
setup
make "remotelist (list [] [] [] [] [] [] [])
make "next-global :first-global
output pass3 pass2 pass1 :code
end

to compile-line :code
let [*result* [] arglist [] locals []
     *pc* 0 name "*toplevel* 
      toplevel? false]
pass2-body :code
output se pass3  :*result* 20
end

-----------------
to pass1 :list
let [*result* [] token " name "*toplevel*]
loop [if empty? :list [output  :*result*]
         make "token pop "list
         if :token = "to  [pass1-fcn pop "list pass1-args pass1-body]
         if :token = "global [setup-globals pop "list]
         if :token = "menu [pass1-menu pop "list pop "list]]
end

to pass1-fcn :proc :args :body
if not empty? get :proc "type
    [error se :proc [already defined]]
add-name :proc
add (list :proc :args :body)
put :proc "args count :args
put :proc "type "ufun
ifelse mmmember? "output :body
   [put :proc "outputs? true]
   [put :proc "outputs? false]
end

to pass1-args
let [*result* []]
loop [if empty? first :list [output  :*result*]
        if not equal? ": first first :list [output :*result*]
         add bf  pop "list]
end

to pass1-body
let [*result* []]
loop [if empty? :list [output  :*result*]
         if equal? "end first :list [ignore pop "list output  :*result*]
         add pop "list]
end

to pass1-menu :num :list
if not number? :num [error se [bad menu number] :num]
if or :num < 1 :num > 7 [error se [bad menu number] :num]
if not list? :list [error se [bad menu command -] :list]
setitem :num :remotelist :list
end

to setup-globals :list
if word? :list [make "list (se bf :list)]
dolist [i :list]
  [add-name :i add-name .word "set :i
   put :i "macro (se "|(| "ew :next-global "|)| )
    put .word "set :i "macro se "dw :next-global
    make "next-global :next-global + 2]
end
   
to mmmember? :a :b
if word? :b [output equal? :a :b]
dolist [i :b][if mmmember? :a :i [output true]]
output false
end

--------------------

to pass2 :list
let [*result* [] *pc* :procs]
loop [if empty? :list [output  :*result*]
        pass2-fcn pop "list]
end

to pass2-fcn :fcn
let [name item 1 :fcn
       arglist item 2 :fcn
       locals []
       body item 3 :fcn
       toplevel? true]
put :name "addr :*pc*
put :name "locals 0
add-and-count se "to :name 2
pass2-body :body 
add-and-count [prim stop] 1
end

to pass2-body :body
let [command? true]
loop [if empty? :body [stop]
        pass2-item pop "body]
end

to pass2-item :item
selectq typeof :item
   [list [command-check :item pass2-list :item stop]
    number [command-check :item add-and-count se "number :item 3 stop]
    quote-symbol [command-check :item add-and-count se "sstring  :item 1 + count :item stop]
    dot-symbol [command-check :item pass2-dsym bf :item stop]]
pass2-symbol :item
end

to typeof :item
if list? :item [output "list]
if number? :item [output "number]
if (first :item) = ": [output "dot-symbol]
if (first :item) = "" [output "quote-symbol]
output "symbol
end

to pass2-symbol :item
let [nargs get :item "args]
if empty? :nargs [try-macro :item stop]
if  :nargs < 0 [error se [not enough inputs to] :item]
ifelse :command? 
    [if get :item "outputs? [error se [you don't say what to do with] :item]]
    [if not get :item "outputs? [error se :item [doesn't output]]]
pass2-argloop
pass2-funcall :item
end

to try-macro :item
let [macro get :item "macro]
if empty? :macro [error se :item "undefined]
make "body se :macro :body
pass2-item pop "body
end

to pass2-argloop
let [toplevel? false command? false]
repeat :nargs [if empty? :body [error se [not enough inputs to] :item]
                        pass2-item pop "body infix-check]
end

to pass2-list :item
let [command? true]
add-and-count [|-[-| 0] 3
pass2-body :item
add-and-count [|-]-| 0] 1
end

to pass2-dsym :item
let [offset dsym-offset :item]
if empty? :offset [error se :item [has no value]]
add-and-count se "lthing  :offset 2
end

to pass2-funcall :item
ifelse equal? get :item "type "ufun
   [ifelse tailcall?
      [add-and-count se "ufun-tail :item 3]
      [add-and-count se "ufun :item 3]]
   [ifelse get :item "special?
      [run (se word "handle- :item)]
      [add-and-count se "prim :item 1]]
end

to tailcall?
output (and :name = :item :toplevel? empty? :body)
end

to command-check :item
if :command? [error se [you don't say what to do  with] :item]
end

to infix-check
if not infix? [stop]
let [fcn pop "body]
pass2-item pop "body
add-and-count se "prim :fcn 1
infix-check
end

; Buggy version of infix due to member? behavior.
; Causes problem with parsing of commands that take > 1 input,
; reported by Berg/Turbak on 1/4/98
; The bug has not yet successfully been fix, so we continue with the old version for now
to infix?
if empty? :body [output false]
output member? first :body :infixes
end

; Brian's fix to infix?, which doesn't work
to brian-infix?
show :body
if empty? :body [output false]
if not equal? 1 first :body [output false]
output member? first :body :infixes
end

; Lyn's version of Brian's fix to infix?, which still doesn't work
to lyn-infix?
show :body
if empty? :body [output false]
if equal? 1 count :body [output false]
output member? first :body :infixes
end

to dsym-offset :var
if member? :var :arglist [output (count :arglist) - itempos :var :arglist]
if member? :var :locals [output  minus (itempos :var :locals)]
output "
end

to handle-let
if :name = "*toplevel* [error [let can only be used in a procedure]]
let [body pop "body]
if not list? :body [error [let needs a list as input]]
loop [if empty? :body [stop]
         make "locals se :locals first :body
         put :name "locals 1 + get :name "locals
         handle-make]
end

to handle-make
let [var .sym pop "body 
       offset dsym-offset :var
      nargs 1]
if empty? :offset [error se :var [isn't a local]]
pass2-argloop
add-and-count se "lmake :offset 2
end

to handle-waituntil
pass2-list-that-outputs
add-and-count [prim waituntil] 1
end

to handle-when
pass2-list-that-outputs
let [nargs 1] pass2-argloop
add-and-count [prim when] 1
end

to pass2-list-that-outputs
add-and-count [|-[-| 0] 3
let [nargs 1 
     newbody (se pop "body)
     body :newbody]
pass2-argloop
add-and-count [|-]-r| 0] 1
end


to |handle-(|
let [nargs 1] pass2-argloop
if not (pop "body) = "|)| [error "|() error|]
end

to |handle-)|
error [misplaced )]
end

to handle-type
if empty? :body [error [not enough inputs to type]]
let [arg first :body]
ifelse member? typeof :arg [quote-symbol list]             ; list or dsym
   [make "body bf :body
     ifelse list? :arg [make "arg (word :arg)][make "arg bf (word :arg)]
    add-and-count [prim .type] 1
    add-and-count se "string :arg (count :arg) + 1]
   [let [nargs 1] pass2-argloop
    add-and-count [prim type] 1]
end

to handle-print
if empty? :body [error [not enough inputs to print]]
let [arg first :body]
ifelse member? typeof :arg [quote-symbol list]            ; list or dsym
   [make "body bf :body
     ifelse list? :arg [make "arg (word :arg)][make "arg bf (word :arg)]
    add-and-count [prim .print] 1
    add-and-count se "string :arg (count :arg) + 1]
   [let [nargs 1] pass2-argloop
    add-and-count [prim print] 1]
end

to handle-say
if empty? :body [error [not enough inputs to say]]
let [arg first :body]
ifelse member? typeof :arg [quote-symbol list]           ; list or dsym
   [make "body bf :body
     ifelse list? :arg [make "arg (word :arg)][make "arg bf string :arg]
    add-and-count [prim .say] 1
    add-and-count se "string :arg (count :arg) + 1]
   [let [nargs 1] pass2-argloop
    add-and-count [prim say] 1]
end

--------------------
to pass3 :list
let [lists []
     *result* []]
repeat 99999
     [if empty? :list [output   :*result*]
      pass3-item pop "list]
end

to pass3-item :item
let [x item 3 :item]
selectq item 2 :item
   [to           [add get :x "args add get :x "locals]
     number [add 10 addw :x ]
     |-[-|     [add 14
		make "lists  fput count :*result* :lists
		add 0 add 0]
     ufun        [add 16 addw get :x "addr]
     ufun-tail [add 18 addw get :x "addr]
     |-]-|      [add-eol 20]
     |-]-r|   [add-eol 22]
     lmake    [add 4 add  :x]
     lthing    [add 2 add  :x]
    prim       [add prim# :x]
     string    [add-string :x]
     sstring    [add 8 add-string :x]]
end

to add-eol :n
add :n
let [offset pop "lists
     len (count :*result*) - :offset - 2]
setnth :offset :*result* int :len / 256
setnth :offset + 1 :*result* remainder :len 256
end

to add-string :word
add count :word
dotimes [i count :word][add ascii item :i + 1 :word]
end

to global# :x
if not member? :x :globals [make "globals se :globals :x]
output itempos :x :globals
end

to prim# :x
output 22 +  2 * itempos :x :prims
end

to addw :n
add int :n / 256 
add remainder :n 256
end

--------------------


to setup-prims :list
if empty? :list [stop]
let [name first :list args item 3 :list]
make "prims se :prims :name
if :args < 0 [make "infixes se :name :infixes]
put :name "type "prim
put :name "args :args 
put :name "special? false
put :name "outputs? equal? "r item 2 :list
setup-prims bf bf bf :list
end

to setup-specials :list
dolist [name :list]
   [put :name "type "prim
     put :name "args 0
     put :name "special? true]
end


to pop :plist
let [first first thing :plist]
make :plist bf thing :plist
output :first
end

to add-and-count :item :len
add se :*pc* :item
make "*pc* sum :*pc* :len
end

to add :item
make "*result* lput :item :*result*
end

to add-name :item
make "plist-names lput :item :plist-names
end

to error :thing
setstatus [No download.]
if not :name = "*toplevel* [make "thing (se :thing "in :name)]
print :thing
stopme
end

to ignore :n
end

to .word :a :b
output intern word :a :b
end

to startup
make "monon false
setup
if empty? portnames [print [no serial port found]]
let [port get-config-param "com-port:]
carefully [if or empty? :port :port = "default [make "port first portnames]] [print [If you are using a USB to serial converter, check to see if it is properly installed.]]
print word [using  port :] :port
print [to use a different port, edit config.txt]
carefully [openport :port setportparams 9600 8 1 0] [print [Can't open serial port]]
end

to get-config-param :name
let [list []]
carefully [make "list parse filetostring "config.txt][]
if empty? :list [output []]
if not 0 = remainder count :list 2 [output []]
repeat (count :list) / 2
[if :name = first :list [output nth 1 :list]
make "list bf bf :list]
output []
end

to serial-reinit
reopenport
setportparams 9600 8 1 0
end

; --------files---------------
to load
let [name askl "toolbox [get-read-file-name "@TEXT "|Load File|]]
if empty? :name [stop]
loadall :name
make "filename :name
end

to save
let [name askl "toolbox [get-write-file-name "|Save as:| :filename]]
if empty? :name [stop]
saveall :name
end

to setup
make "plist-names []
make "prims [] make "infixes []
make "procs 0xa400 make "remotes 0xa000 make "first-global 0xbc00 
make "ascii 0xf000 make "command-line 0xfd00
setup-prims 
   [stop c 0  output c 1  make c 2  + r -1  = r -1  if c 2  repeat c 2  waituntil c 0
     send c 1  resett c 0  timer r 0  wait c 1  db c 2  eb r 1  and r 2  or r 2
     dw c 2  ew r 1  - r -1  not r 1  on c 0  off c 0  thisway c 0  thatway c 0
     rd c 0  a, c 0  b, c 0  c, c 0  d, c 0  ab, c 0 cd, c 0 abcd, c 0 toggle c 0 setpower c 1 > r -1 < r -1
     switch r 1 sensor r 1 
     .type c 0  .print c 0  type c 0  print c 0  top c 0  bottom c 0  knob r 0  button r 0 
     loop c 1  ifelse c 3  launch c 1  forever c 1  onfor c 1  when c 0  * r -1  / r -1  \\ r -1
      erase c 0  record c 1  resetr c 0  recall r 0  record#  r 0  recall# r 0
     unrecord r 0  every c 2  ad, c 0  bc, c 0  note c 2   ir r 0 
     stoprules c 0 irsend c 1 recc r 0  .say c 0 say c 0 random r 1 remote-off c 0
     counter r 1 resetc c 1 beep c 0 printx c 1 sayx c 1 senda7 c 1]                        
setup-specials [make ( ) waituntil when type print let say]
put "|(| "outputs? true put "|)| "outputs? false put "let "outputs? false
end

to load-file
loadall user-filename
end

to save-file
saveall user-filename
end

to user-filename 
output (word "robot char 32 "programs\\ textitem 1 "text1)
end

to boot-code
output[$ff
  $8E $00 $FF $86 $10 $B7 $10 $35 $86 $25 $B7 $10 $3C $86 $80 $B7 
  $10 $01 $86 $B0 $B7 $10 $2B $8D $6E $81 $3E $27 $0A $81 $7D $27 
  $13 $81 $3C $27 $28 $20 $F0 $8D $45 $8D $5C $A7 $00 $08 $18 $09 
  $26 $F7 $20 $E3 $8D $38 $8D $4F $18 $3C $C6 $16 $8D $18 $C6 $02 
  $8D $14 $8D $3A $18 $38 $08 $18 $09 $26 $EB $20 $CA $8D $27 $8F 
  $A6 $00 $8D $2A $20 $C1 $F7 $10 $3B $A7 $00 $5C $F7 $10 $3B $8D 
  $04 $7F $10 $3B $39 $18 $CE $0B $B8 $18 $09 $26 $FC $39 $8D $06 
  $8F $8D $03 $18 $8F $39 $8D $0F $36 $8D $0C $16 $32 $39 $F6 $10 
  $2E $2A $FB $B7 $10 $2F $39 $B6 $10 $2E $84 $20 $27 $F9 $B6 $10 
  $2F $39 $0C $16 $32 $39 $F6 $10 $2E $2A $FB $B7 $10 $2F $39 $B6 
  $10 $2E $84 $20 $27 $F9 $B6 $10 $2F $39 $10 $2F $39 $B6 $10 $2E 
  $84 $20 $27 $F9 $B6 $10 $2F $39 $10 $2F $B6 $10 $2E $84 $20 $27 
  $F9 $B6 $10 $2F $39 $02 $00 $00 $04 $00 $00 $00 $00 $20 $00 $00 
  $00 $00 $00 $00 $00 $00 $00 $B6 $1D $42 $28 $00 $00 $B4 $B5 $92 
  $00 $B4 $B5 $68 $14 $2D $02 $10 $00 $00 $00 $00 $00 $00 $00 $0C 
  $64 $65 $76 $65 $6C $6F $70 $53 $74 $61 $67 $65 $00 $00 $00 $B4]
end

to rb :addr
send 60
send int :addr / 256
send remainder :addr 256
output recc
end

to boot-load
setportparams 1200 8 1 0
wait 5
dolist [i boot-code] [send :i]
wait 5
setportparams 9600 8 1 0
clearcom
end

to send :n
.send :n
end

to recc
let [c 0]
loop [make "c .recc
      if :c > -1 [output :c]]
end
