REBOL [
  Title: "Direct File Transfer"
  Short: "Direct File Transfer"
  Author: ["Henrik Mikael Kristensen"]
  Copyright: "2007 - HMK Design"
  Filename: %direct.r
  Version: 0.0.1
  Created: 14-Feb-2007
  Date: 14-Feb-2007
  License: {
    BSD (www.opensource.org/licenses/bsd-license.php)
    Use at your own risk.
  }
  Purpose: {
    Very small file transfer client.
  }
  History: []
  Keywords: []
]

flash "Connecting..."

do http://www.hmkdesign.dk/rebol/rugby/rugby.r
;do %/Volumes/c/rebol/rugby-pub/rugby.r
net: context get-rugby-service http://rebol.hmkdesign.dk:8007

unview

chunk-size: net/get-chunk-size
file-offset: 1
f-file: file-length: none

get-segment: func [
  "Grabs the latest file segment of a remote file"
  remote-file [integer! string!]
  local-file [file!]
  offset [integer!]
  /local segment
][
  unless offset [offset: get in info? local-file 'size]
  segment: net/get-segment remote-file offset
  either 'past-end = segment [
    segment
  ][
    either file-length < file-offset [
      'past-end
    ][
      any [
        all [not check-segment segment 'checksum-error]
        segment
      ]
    ]
  ]
]

check-segment: func [
  "Checks the received segment"
  segment [block!]
] [
  equal? segment/1 checksum/method segment/2 'sha1
]

get-file: func [
  remote-file [integer! string!] local-file [file!] /local start-offset
] [
  start-offset: either exists? local-file [
    get in info? local-file 'size
  ][
    0
  ]
  set-face p-percent "0% completed"
  unless any [
    start-offset >= file-length
  ] [
    ; ---------- Download Process
    until [
      unless
        find [past-end checksum-error]
        segment:
          get-segment remote-file local-file start-offset + file-offset [
        write/binary/append local-file segment/2
        file-offset: file-offset + chunk-size
        set-face p-file file-offset / file-length
        set-face p-percent reform [
          join round/to 100 * get-face p-file 0.1 "%" "completed"
        ]
      ]
      file-length < file-offset
    ]
  ]
  set-face p-file 1
  set-face p-percent "File done"
  file-offset: 1
]

view layout [
  style lb label shadow none
  origin 10 space 4 across
  backdrop effect [gradient 0x1 200.180.100 150.120.50]
  lbl "1. Paste the code here and tab out" return
  f-code: field [
    if attempt [to-integer trim get-face f-code] [
      file-length: net/file-code to-integer trim get-face f-code
      set-face f-remote-file either file-length [
        net/file-name to-integer trim get-face f-code
      ][
        "No file exists for this code"
      ] 
      set-face f-remote-file-size if file-length [
        reform [file-length "bytes"]
      ]
    ]
  ] return
  lbl "Remote file is:" return
  f-remote-file: text 200 "No code specified" return
  f-remote-file-size: text 200 return
  lbl "2. Choose file to save as" return
  f-local-file: field [
    attempt [f-file: to-file get-face face]
  ] return
  f-filename: btn 200.200.200 200 "Choose file to save" [
    all [
      f-file: request-file/save/file
        to-file get-face f-remote-file
        not empty? f-file
        f-file: first f-file
        set-face f-local-file to-string f-file
    ]
  ] return
  lbl "3. Press button to start download" return
  btn 200.200.200 200 gray "Get file!" [
    all [
      file-length
      file? f-file
      get-file to-integer trim get-face f-code f-file
    ]
  ] return
  lbl "File progress" return
  p-file: progress 200 black yellow return
  p-percent: text 200 font-size 11
]