...try it out. I had few time to work on it, but I think it can
be interesting. Let me know what you think!
Regards,
Gabriele.
--
o--------------------) .-^-. (----------------------------------o
| Gabriele Santilli / /_/_\_\ \ Amiga Group Italia --- L'Aquila |
| GIESSE on IRC \ \-\_/-/ / http://www.amyresource.it/AGI/ |
o--------------------) `-v-' (----------------------------------o
REBOL [
Title: "Simple file manager"
]
; -- interfaccia testuale (richiede REBOL 2.2)
restring: func [b] [make string! reduce b]
control-sequences: make object! [
csi: "^(1B)["
sequence: func [
s [block!]
] [
restring bind s 'self
]
left: func [
"Sposta il cursore n caratteri a sinistra"
n [integer!]
] [
sequence [csi n "D"]
]
right: func [
"Sposta il cursore n caratteri a destra"
n [integer!]
] [
sequence [csi n "C"]
]
up: func [
"Sposta il cursore n righe in alto"
n [integer!]
] [
sequence [csi n "A"]
]
down: func [
"Sposta il cursore n righe in basso"
n [integer!]
] [
sequence [csi n "B"]
]
move-to: func [
"Sposta il cursore alla posizione specificata"
row [integer!]
column [integer!]
] [
sequence [csi row ";" column "H"]
]
home: sequence [csi "H"]
delete: func [
"Cancella n caratteri a destra"
n [integer!]
] [
sequence [csi n "P"]
]
insert: func [
"Inserisce n spazi"
n [integer!]
] [
sequence [csi n "@"]
]
cls: sequence [csi "J"]
clear-to-end-of-line: sequence [csi "K"]
cursor-pos: sequence [csi "6n"]
dimensions: sequence [csi "7n"]
]
input-codes: make object! [
up: "^(1B)[A"
down: "^(1B)[B"
right: "^(1B)[C"
left: "^(1B)[D"
;home: "^(1B)[H"
;end: "^(1B)[E"
page-up: "^(1B)[5~"
page-down: "^(1B)[6~"
;insert: "^(1B)[I"
delete: "^(7F)"
tab: "^-"
enter: "^M"
]
input-loop: func [
"Ciclo di attesa dell'input"
body [block!]
] [
body: copy body
forskip body 2 [
if word? body/1 [
change body get in input-codes body/1
]
]
forever [
switch get-input head body
]
]
send-sequence: func [
"Invia una sequenza alla console"
seq [block!]
] [
write/binary console:// restring bind seq in control-sequences 'self
]
digits: charset "1234567890"
console-get: func [
"Legge la posizione del cursore o le dimensioni della console"
'what [word!]
/local row col
] [
send-sequence reduce [what]
; parse sar� studiata nella prossima lezione
parse/all get-input [
"^(1B)["
copy row some digits
";"
copy col some digits
"R" end
]
reduce [to-integer row to-integer col]
]
get-cursor: func [] [console-get cursor-pos]
get-dimensions: func [] [console-get dimensions]
footer: "Q: Quit TAB: Exchange S/D DEL: Del. P: Prev. V: Show C: Copy M: Move"
redraw: func [
"Ridisegna lo schermo"
/local width height
] [
set [height width] get-dimensions
send-sequence [
cls
move-to height 1
copy/part footer width
home
]
lister1/set-rect 1 1 to-integer width / 2 height - 1
lister2/set-rect (to-integer width / 2) + 1 1 to-integer width / 2 height - 1
lister1/redraw
lister2/redraw
]
get-input: func [] [
to-string read/binary/wait console://
]
show-text: func [
"Mostra un testo a schermo"
lines [block!]
sk [integer!]
rows [integer!]
margin [integer!]
/local line x
] [
rows: min rows length? lines
line: make paren! [copy/part skip lines/1 sk margin]
x: margin + 2
for y 2 rows + 1 1 [
send-sequence [
move-to y 2
line clear-to-end-of-line
move-to y x "|"
]
lines: next lines
]
]
show-box: func [
"Mostra un riquadro a schermo"
x [integer!]
y [integer!]
lines [block!]
] [
for y y (y + length? lines) - 1 1 [
send-sequence [
move-to y x
lines/1
]
lines: next lines
]
]
message: func [
"Visualizza un messaggio"
msg [string! block!] "Linea o blocco di linee"
/confirm "Chiede conferma all'utente"
/local scrw scrh boxw boxh boxx boxy box border blank res
] [
set [scrh scrw] get-dimensions
if string? msg [msg: reduce [msg]]
boxh: length? msg
boxw: 13
foreach line msg [if boxw < length? line [boxw: length? line]]
box: make block! 100
border: make string! 100
blank: make string! 100
insert insert/dup insert border "+" "-" boxw "+"
insert/dup blank " " boxw
boxx: to-integer ((scrw - boxw) / 2) - 1
boxy: to-integer ((scrh - boxh) / 2) - 1
insert box border
foreach line msg [
insert tail box restring [
"|" head change copy blank copy/part line boxw "|"
]
]
insert tail box border
res: either confirm [
insert tail box restring [
"| [Y]es" head insert/dup copy "" " " (boxw - 10) "[N]o |"
]
insert tail box border
boxy: boxy - 1
show-box boxx boxy box
use [input] [
while [not found? find ["Y" "N"] input: get-input] []
input = "Y"
]
] [
show-box boxx boxy box
get-input
]
redraw
res
]
lister: make object! [
x: y: w: h: 0
border: make string! 100
blank: make string! 100
set-rect: func [
xx yy ww hh
] [
set [x y w h] reduce [xx yy ww hh]
clear border
clear blank
insert insert/dup insert border "+" "-" w - 2 "+"
insert insert/dup insert blank "| " " " w - 3 "|"
]
list: make block! 0
current: 1
redraw: func [
"Disegna il lister"
/local line row
] [
send-sequence [
move-to y x
border
move-to y + h - 1 x
border
]
row: y + 1
foreach element copy/part list h - 2 [
line: head
change
next next copy blank
copy/part form element w - 3
send-sequence [
move-to row x
line
]
row: row + 1
]
for row row y + h - 2 1 [
send-sequence [
move-to row x
blank
]
]
draw-pointer
]
draw-pointer: func [] [
send-sequence [
move-to y + current x + 1
">"
]
]
clear-pointer: func [] [
send-sequence [
move-to y + current x + 1
" "
]
]
down: func [] [
if current < length? list [
clear-pointer
either current < (h - 2) [
current: current + 1
draw-pointer
] [
list: next list
redraw
]
]
]
up: func [] [
either current > 1 [
clear-pointer
current: current - 1
draw-pointer
] [
if not head? list [
list: back list
redraw
]
]
]
get-current: func [] [
pick list current
]
]
lister1: make lister []
lister2: make lister []
; -- file manager
change-active-dir: func [
"Cambia la directory corrente"
dir [file!]
] [
source-dest/2: dir
source-dest/1/list: sort read dir
source-dest/1/current: 1
source-dest/1/redraw
]
refresh: func [] [
source-dest/1/list: sort read source-dest/2
source-dest/3/list: sort read source-dest/4
redraw
]
swap: func [
"Scambia sorgente e destinazione"
sd [block!]
] [
change sd reduce [sd/3 sd/4 sd/1 sd/2]
]
cases-dialect: make object! [
else-if: if: func [
condition
body [block!]
] [
system/words/if condition [
do body
true
]
]
else: :do
]
do-cases: func [
cases [block!]
] [
any bind cases in cases-dialect 'self
]
form-error: func [
"Genera un messaggio di errore"
error [error!]
/local id type
] [
error: disarm error
id: error/id
type: error/type
reduce [
"*** Error"
reform ["*** Type:" system/error/:type/type]
reform ["*** Why:" reform bind system/error/:type/:id in error 'self]
reform ["*** Near:" trim/lines mold error/near]
]
]
execute-script: func [
"Esegue lo script specificato"
script [file!]
/local result id type
] [
send-sequence [cls]
print "Provo ad eseguire lo script..."
either error? result: try [do script] [
foreach line form-error result [
print line
]
] [
print ["Risultato dello script:" mold result]
]
print "Un tasto per continuare..."
get-input
refresh
]
text?: func [
file [file!]
/local freq sum
] [
file: read/binary/part file 512
freq: array/initial 256 0
foreach byte file [
byte: byte + 1
poke freq byte freq/:byte + 1
]
sum: 0
for i 32 126 1 [sum: sum + freq/:i]
sum > ((4 * length? file) / 5)
]
view-text: func [
textfile [file!]
/local scrh scrw border footer sk refresh maxskip maxindex
] [
set [scrh scrw] get-dimensions
border: make string! 100
insert insert/dup insert border "+" "-" scrw - 2 "+"
footer: "Q: Quit Arrows,PgUp,PgDown: Scrolling"
send-sequence [
cls
border CRLF
down scrh - 3
border CRLF
copy/part footer scrw
]
for i 2 scrh - 2 1 [
send-sequence [
move-to i 1 "|"
right scrw - 2 "|" CRLF
]
]
textfile: parse/all detab/size read textfile 4 "^/"
maxskip: 0
foreach line textfile [if maxskip < length? line [maxskip: length? line]]
maxskip: max 0 maxskip - (scrw - 2)
maxindex: (4 + length? textfile) - scrh
show-text textfile 0 scrh - 3 scrw - 2
sk: 0
refresh: make paren! [
show-text textfile sk scrh - 3 scrw - 2
]
input-loop [
"Q" [break]
up [
if not head? textfile [
textfile: back textfile
refresh
]
]
down [
if maxindex > index? textfile [
textfile: next textfile
refresh
]
]
left [
if sk > 0 [
sk: sk - 1
refresh
]
]
right [
if sk < maxskip [
sk: sk + 1
refresh
]
]
page-up [
if not head? textfile [
textfile: skip textfile negate scrh - 4
refresh
]
]
page-down [
if maxindex > index? textfile [
textfile: skip textfile min scrh - 4 maxindex - index? textfile
refresh
]
]
]
redraw
]
show-info: func [
"Mostra informazioni sul file"
file [file!]
/local name maxlen info
] [
maxlen: to-integer (pick get-dimensions 2) / 2
name: form file
if maxlen < length? name [
name: restring ["..." skip tail name negate (maxlen - 3)]
]
info: info? file
message reduce [
restring ["Informations on " name]
restring ["Size: " info/size]
restring ["Last modification: " info/date]
]
]
source-dest: reduce [
lister1 system/script/path
lister2 system/script/path
]
refresh
show-message-on-error: func [
"Se avviene un errore, mostra un messaggio"
code [block!] "Codice da eseguire"
/local error
] [
if error? set/any 'error try code [
message form-error error
]
]
input-loop [
"Q" [
send-sequence [cls]
break
]
up [
source-dest/1/up
]
down [
source-dest/1/down
]
tab [
swap source-dest
]
enter [
show-message-on-error [
file: join source-dest/2 source-dest/1/get-current
do-cases [
if dir? file [
change-active-dir file
]
else-if script? file [
execute-script file
]
else-if text? file [
view-text file
]
else [
show-info file
]
]
]
]
"P" [
show-message-on-error [
change-active-dir first split-path source-dest/2
]
]
delete [
show-message-on-error [
file: source-dest/1/get-current
if message/confirm reduce [
"Confermi la cancellazione del file:"
restring [file " ?"]
] [
delete join source-dest/2 file
refresh
]
]
]
"V" [
show-message-on-error [
view-text join source-dest/2 source-dest/1/get-current
]
]
"C" [
show-message-on-error [
use [source dest file] [
source: join source-dest/2 file: source-dest/1/get-current
dest: join source-dest/4 file
write/binary dest read/binary source
]
refresh
]
]
"M" [
show-message-on-error [
use [source dest file] [
source: join source-dest/2 file: source-dest/1/get-current
dest: join source-dest/4 file
write/binary dest read/binary source
system/words/delete source
]
refresh
]
]
"R" [refresh]
]
