...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] ]