Morse code generator

In just one line Mr. Johan Roennblom created a morse code generator:
foreach c ask{Message:} [l: index? find{ etinamsdrgukwohblzfcpövxäqüyj}c while[l >= 2][prin pick{-.}odd? l l: l / 2]prin" "]print""


Example:
Message:Hello world
.... . .-.. .-.. --- .-- --- .-. .-.. -..

One liner: chess board

How to create a chess board with just one line of Rebol (I splitted t in 3 lines for beginers) :
Rebol [
    Title: "Chess board"
    Date: 20-Jul-2003
    File: %oneliner-chess-board.r
    Purpose: "Displays an empty chess board"
    One-liner-length: 126
    Version: 1.0.0
    Author: "Sunanda"  
]
g:[style b box black 50x50   style w b white space 0x0   ]
loop 8 append g head reverse/part [b w b w b w b w return] 8 ]
view layout g


Time! and date!

Hello, I just discovered some funny properties of date and time format. Let's see them together!
First of all let's create two variable containing a date and a time value:

>> a: now/date
== 24-May-2013
>> b: now/time
== 12:31:46


Well you can call each single value (day, minutes, etc.) in many ways:

>> a/day
== 21
>> a/1
== 21
>> a/month
== 5
>> a/year
== 2013
>> b/hour
== 12
>> b/minute
== 31
>> b/second
== 46.0


As you can see, you can ask for hour or minute in a very human friendly way. However you can use also position number.
You can perform this also in a complete date:

>> c: now
== 24-May-2013/12:39:06+2:00
>> c/date
== 24-May-2013
>> c/time
== 12:39:06
>> c/time/hour
== 12
>> c/date/year
== 2013


Now you know all ways to call a single part of a date! variable

Nim game

Today I'll write about the NIM game, it's a simple game:



There are some piles of tokens, every turn can remove any number of token from a pile, the player loose if he remove the last token from the last pile.

Sunada wrote the following script that permits you to play against your PC:

rebol [
        title: "Nim engine"
      purpose: "Calculate the best move in a game of NIM"
      author: "Sunanda"
        date:   1-sep-2004
      version:   0.0.0
        file:   %nim-engine.r
        license: 'bsd        
      history: [   [0.0.0 1-sep-2004 "written"]   ]
      credits: {Analysis and terminology taken from
                "The Mathematics of Games"
                John D. Beasley
                Oxford University Press, 1989
                }
]
;; --------------------------------------------------------------------------
;; See documentation:
;;   http://www.rebol.org/documentation.r?script=nim-engine.r
;; --------------------------------------------------------------------------

nim-engine: make object! [
;; Game types:
;; **   Common:   take last and lose
;; ** Straight: take last and win

res: none             ;; make available to whole nim-move object
piles-copy: none     ;; caller's original piles
player-names: none   ;; name of the two players

test-trace: none   ;; test driver output

game-types: ["common"   "lose if you take the last counter"
              "straight" "win if you take the last counter"
            ]
;; =====
  move: func [
;; =====
              game-type [string!]   "Common or Straight"
              piles [block!]         "1 or more piles"
              /names names-block [block!] ;; [this player + other player]
  /local
  cp           ;; count of piles
  temp
][
if 0 = length? piles [make error! "nim-move: need at least 1 pile"]
if not any [
            game-type = "common"
            game-type = "straight"
            ]
            [make error! "nim-move: game type must be common or straight"]
if all [names 2 <> length? names-block]
        [make error! "nim-move: name refinement -- 2 names needed"]
either names
    [player-names: copy names-block]
    [player-names: copy ["nim-engine" "human"]]
res: make object!
    [game-type: none
      game-over?: false
      winner?: none
      move: none
      piles: copy []
      winning?: none
    ]
res/game-type: game-type
;; Make the piles make sense
;; -------------------------
;; * Set any negative ones to
;;   zero
;; * Make sure they are all
;; * integers (reduce [2 ** 5]
;;   would be a decimal, and
;;   that breaks the find in
;;   check-for-win

res/piles: copy []
foreach p piles
    [append res/piles maximum 0 to-integer p]
;; ------------------------------------------------
;; Check for game over already (all piles are zero)
;; ------------------------------------------------

if all [res/piles/1 = 0
        (skip res/piles 1) = copy/part res/piles -1 + length? res/piles
        ]
        [
        res/game-over?: true
        res/winner?: either res/game-type = "common" [player-names/1] [player-names/2]
        res/winning?: res/winner?
        return res
        ]
;; ------------------------
;; check for common end game
;; -------------------------

  if all[game-type = "common"
        common-end-game-reached?
        ]
      [
        make-common-end-game-move
        check-for-win
        return res
      ]
;; ----------------------
;; Handle all other cases
;; ----------------------
;; This is for all straight
;; games, and non-end game
;; common games

cp: find-balance piles
res/winning?: cp <> 0
either res/winning?
  [make-winning-move cp]
  [make-random-move]
check-for-win
return res
]
;; ==============
  check-for-win: func [
;; ==============
  /local
    target-size
][
if pair? res/move
    [
    target-size: pick res/piles res/move/1
    res/move/1: random-entry res/piles target-size
    poke res/piles res/move/1 (pick res/piles res/move/1) - res/move/2
    ]
;; Check for game over
;; -------------------

if all [res/piles/1 = 0
        (skip res/piles 1) = copy/part res/piles -1 + length? res/piles
        ]
        [
        res/game-over?: true
        res/winner?:   either   res/game-type = "common"
              [player-names/2]
              [player-names/1]
        res/winning?: res/winner?
        ]
return true
]
;; =============
  random-entry: func [piles [block!]   target [integer!]
;; =============
    /local
    target-positions
][
;; -------------------------
;; We've got a set of piles,
;; eg:
;; [1 3 0 0 11 3 7 5 9]
;; and a target, eg:
;; 6
;;
;; We now want to return the
;; index of a pile with at
;; least 6 counters in it --
;; eg
;; 5 or 7 or 9
;; in the example

target-positions: copy []
repeat n length? piles
    [if piles/:n = target
        [append target-positions n]
    ]
return random/secure/only target-positions
]
;; ============
  find-balance: func [piles [block!]
;; ============
  /local
    bal
][
bal: 0
foreach p piles [bal: xor bal p]
return bal
]
;; =========================
  common-end-game-reached?: func [
;; =========================
  /local
    count
][
;; The end game is when either:
;; * all non-empty piles have 1 counter; or
;; * all non-empty piles but 1 have 1 counter.
;; eg:
;; [1 0 0 1 1 1 0 0 ]   ;; all have 1 counter
;; [1 1 0   1 0 0 88]   ;; all but 1 have one counter

count: 0
foreach p res/piles
  [
  if p > 1 [count: count + 1]
  ]
return any [count = 0 count = 1]
]
;; ==========================
  make-common-end-game-move: func [
;; ==========================
    /local
    pi
    move
    take
    piles-count
][
;; ================================
;; Precisely one non-zero pile has
;; one or more counters.
;; And it is a common game
;; ================================
;;
;; We have a win if:
;; a) we can reduce the piles to an
;;     odd number, all with 1 in them

piles-count: 0
foreach p res/piles
    [if p <> 0
      [piles-count: piles-count + 1]
    ]
if   0 = (piles-count // 2)
[
  ;; even piles: reduce the largest to zero
  ;; --------------------------------------

  move: index? find res/piles max-element res/piles
  take: res/piles/:move
  res/move: to-pair reduce [move take]
  res/winning?: player-names/1
  return true
  ]
;; Deal with odd number of piles
;; ------------------------------

if 1 <> max-element res/piles
[
  res/winning?: player-names/1
  move: index? find res/piles max-element res/piles
  take: res/piles/:move - 1
  res/move: to-pair reduce [move take]
  return true
]
;; -----------------------
;; We're losing: and all
;; piles have one in them,
;; except the empty piles
;; -----------------------

res/winning?: player-names/2
take: 1
move: index? find res/piles take
res/move: to-pair reduce [move take]
return true
]
;; ==================
  make-winning-move: func [cp [integer!]
;; ==================
  /local
    h-un
    target-pile
    piles-reduced
    move
    take
    h-un-rem
][
  ;; cp contains the binary of the highest unbalanced
  ;; pile contents, eg
  ;; cp: 12   =   8 + 4
  ;; therefore the 8s and the 4s are unbalanced --
  ;; perhaps the original piles were:
  ;; [17 24 8 12 8 4]   = [16+1 16+8 8 8+4 4+1]

  ;; set h-un to the bit value of the
  ;; highest unbalance number

target-pile: find-highest-unbalanced-pile cp res/piles
;; Now, ignore that pile
;; ---------------------

  piles-reduced: copy res/piles
  alter piles-reduced target-pile
;; Now find highest unbalanced of what remains
;; -------------------------------------------

h-un-rem: find-balance piles-reduced piles-reduced
move: index? find res/piles target-pile
take: res/piles/:move - h-un-rem
res/winning?: player-names/1
res/move: to-pair reduce [move take]
return true
]
;; =============================
  find-highest-unbalanced-pile: func [cp [integer!] piles [block!]
;; =============================
  /local
    h-un
][
if cp = 0 [return 0]
h-un: to integer! 2 ** (to integer! log-2 cp)
foreach p sort/reverse copy piles
  [
    if 0 <> and h-un p [return p]
  ]
return 0   ;; there isn't one
]
;; =================
  make-random-move: func [
;; =================
  /local
    move
    take
][
;; -------------------------------------------
;; We're losing, so do something impressive:
;; Ideally, do not remove a pile completely --
;; that simplifies the game too much.
;;
;; And remember to ignore the empty piles
;; -------------------------------------------

;; attempt to find a random pile with 2 or more counters
;; -----------------------------------------------------

take: 0
foreach p random/secure copy res/piles
    [if p > 1 [take: p break]]
if take = 0   [take: 1]     ;; have to play a one

move: index? find res/piles take ;; find the first pile of that size

If take > 3 [take: take - 1]   ;; avoid taking them all
take: random/secure take
res/move: to-pair reduce [move take]
res/winning?: player-names/2
return true
]
;; ==========
  max-element: func [blk [block!]
;; ==========
][
;; maximim-of is useless for our purposes
;; as it can return a block, eg:
;; maximum-of [1 1 9 9 9]
;; returns [9 9 9]

return first maximum-of blk
]
;; ===========
  test-driver: func [
;; ===========
  /local
    games-played
    moves-made
    piles
    game-type
    res
    winning?
    win-names
    diff-piles
    temp
;;   -------------------------
;;   Runs 1000s of games and
;;   checks that the results
;;   are right...or at least
;;   credible.
;;   ------------------------
][
win-names: ["human" "nim-engine" "human"]
games-played: 0
moves-made: 0
forever
[test-trace: copy []
  games-played: games-played + 1
  piles: copy []
  loop 5 + random/secure 5 [append piles random/secure 20]
  game-type: random/secure/only ["common" "straight"]
;; get who is supposed to be winning
;; ---------------------------------

  res: move game-type piles
  winning?: select win-names res/winning?
forever
    [
    moves-made: moves-made + 1
    res: move game-type piles
    append test-trace res
    if not find win-names res/winning?
        [print "bad winner name" halt]
    if res/game-over? [break]
    if res/winning? = winning?
        [print ["didn't rotate winner names" mold res] halt]
    ;; exactly 1 pile should be different
    ;; ----------------------------------
    diff-piles: copy []
    diff-all: copy []
    if (length? piles) <> length? res/piles
          [print "bad pile length" halt]
    repeat n length? piles
          [
          if res/piles/:n < 0
              [print ["result is negative!!" mold res] halt]
            if (temp: piles/:n - res/piles/:n ) <> 0
                [append diff-piles temp]
            append diff-all temp
          ]
    if 1 <> length? diff-piles
          [print ["piles are wrong" mold piles "--" mold res "--" mold diff-piles mold diff-all] halt]
    if diff-piles/1 < 1
          [print ["changed result is negative!!" mold piles "-" mold res "--" mold diff-piles mold diff-all] halt]
    piles: copy res/piles
    winning?: copy res/winning?
    ] ;; forever
if 0 = (games-played // 100)
  [
print [now/precise "Played:" games-played   "Total moves:" moves-made "Average:" moves-made / games-played]
  ]
] ;; forever

]
;; =========
  play-game: func [
;; =========
    /type game-type
    /opponent-starts
    /position starting-position [block!]
    /local
      piles
      res
      human-move
][
if not type [game-type: "common"]
print "Enter moves as a pair!"
print "eg 3x7 means take from pile 3. The number of counters taken is 7"
forever [
piles: copy []
either position
        [piles: copy starting-position]
        [loop 2 + random/secure 3   [append piles random/secure 8]]
loop 2 [print ""]
print [" game type:" game-type " ... " select game-types game-type]
loop 2 [print ""]
print [" starting position:" mold piles]
if opponent-starts
  [res: move game-type piles
    print ["   nim-engine:" res/move mold res/piles]
    piles: res/piles
  ]
forever
  [until
      [human-move: ask "Your move? "
      human-move: load human-move
      either all [pair? human-move
            human-move/1 > 0
            human-move/1 <= length? piles
            human-move/2 > 0
            human-move/2 <= pick piles human-move/1
          ]
          [true]
          [print "----Oops: not possible to do that. Please try again----" false]
      ]
  poke piles human-move/1 (pick piles human-move/1) - human-move/2
  print ["You moved:" mold piles]
  print ""
  print "-----------------Thinking------------"
  wait (.01 * random/secure 50)
  print ""
  res: move game-type piles
  print ["   nim-engine moves: " res/move]
  print ["     position now: " mold res/piles]
  piles: res/piles
  if res/game-over?
    [print "Game over!!"
      print ["Winner: " res/winner?]
      break
      ]
  ] ;; forever
if not (trim/lines ask "play-again? (y for yes) ") = "y" [break]
] ;; foever
]
] ;; nim-engine object



How it works?
Well, you can find a very good documentation here: http://www.rebol.org/documentation.r?script=nim-engine.r
I'll just explain it shortly, launch nim-engine/play-game:

>> nim-engine/play-game
Enter moves as a pair!
eg 3x7 means take from pile 3. The number of counters taken is 7


game type: common ... lose if you take the last counter


starting position: [7 3 4 3 1]
Your move?


It shows the situation as a block, every item of the block is the number of tokens in the pile.
You have to give a pair! to indicate "pile X tokens" to remove.

This script is also a nim engine to create cool games with GUI, just launch it with /move refinement, and you'll obtain an object with the PC move:

>> a: nim-engine/move "common" [3 4 5]
>> ? a
A is an object of value:
game-type string! "common"
game-over? logic! false
winner? none! none
move pair! 1x2
piles block! length: 3
winning? string! "nim-engine"


This is the object explained:

game-type	"common" game -- you lose if you take the last counter "straight" game -- you win if you take the last counter
game-over?	true/false depending on whether more moves are possible
winner?	who won ("human" or "nim-engine") if the game is over
move	(assuming the game wasn't over when you made the call) the move nim-engine is making. A pair: 1x2 means taking 2 from pile 1
piles	the updated position block
winning?	which player is winning

Can you create a GUI for this game?

Facebook Hacker cup 2013

Every year Facebook donate $ 10'000 to the winner of its Hacker cup tournament.
Did you know that you may participate using Rebol?



Well, if you were interested winning $10'000, you should try to solve the following real tournament questions:

• http://rebol.informe.com/forum/rebol-2-f8/hacker-cup-2013-final-problem-1-t60.html
• http://rebol.informe.com/forum/rebol-2-f8/hacker-cup-2013-final-problem-2-t61.html
• http://rebol.informe.com/forum/rebol-2-f8/hacker-cup-2013-final-problem-3-t62.html
• http://rebol.informe.com/forum/rebol-2-f8/hacker-cup-2013-final-problem-4-t63.html

Post your solution on the forum, let's see who is the best rebol coder!

Net tools

If you liked the last post about net scan, you'll love this script. The following script is a collection of useful tool for analyzing our PC ports, net configuration and more; look here:


Here is the source code:

REBOL [
    File: %nettools.r
    Date: 12-July-2006
    Title: "Network Tools"
    Version: 1.1
    Author: "François Jouen"
    Rights: {Copyright © EPHE 2006}
    Purpose: {Collection of network tools}
        license: 'BSD
]
; some useful information
host_address: system/network/host-address
host_name: system/network/host
Get_Os: does [
    switch system/version/4 [
        3 [os: "Windows" countos: "n"]
        2 [os: "MacOSX" countos: "c"]
        4 [os: "Linux" countos: "c"]
        5 [os: "BeOS" countos: "c"]
        7 [os: "NetBSD" countos: "c"]
        9 [os: "OpenBSD" countos: "c"]
        10 [os: "SunSolaris" countos: "c"]
    ]
]
Update-Panel: func [pnl] [
        pnl/pane/offset: 0x0
        show [pnl]
]
Set_TimeOut: func [newto] [
    oldto: system/schemes/default/timeout
    system/schemes/default/timeout: newto
]
Restore_TimeOut: does [system/schemes/default/timeout: oldto ]
Get_OS
; main window

MainWin: layout [
    origin 0x0
    space 0x0
    at 5x15 osinfo: info os 100 center
    at 5x45 b1: btn 100 "Host" [p1/pane: HostView update-panel p1]
    at 5x70 b2: btn   100 "DNS" [p1/pane: NetView update-panel p1]
    at 5x95 b3: btn   100 "Netstat" [p1/pane: NetStatView update-panel p1]
    at 5x120 b4: btn 100 "Ping" [p1/pane: PingView update-panel p1]
    at 5x145 b5: btn 100 "Finger" [p1/pane: FingerView update-panel p1]
    at 5x170 b6: btn 100 "Whois" [p1/pane: WhoisView update-panel p1]
    at 5x195 b7: btn 100 "Port Scan" [p1/pane: ScanView update-panel p1]
    at 5x220 bq: btn 100 "Quit" [Quit]
    at 120x5 p1: box 520x250 silver frame white
]
; useful routines to access network interfaces associated to the hostview layout

Get_Interfaces: func [] [
    i: 0
    cnx: open tcp://
    data: get-modes cnx 'interfaces
    close cnx
    ni: length? data
    ni_info/text: join "Network Interfaces [" [ni"]"]  
    clear ni_choice/data
    for i 1 ni 1 [append ni_choice/data i]
    show [ni_info ni_choice]
    return ni
]
Get_Informations: func [number][
    card: pick data number
    nic_name/text: card/name
    nic_adress/text: card/addr
    nic_subnet/text: card/netmask
    either found? find card/flags 'broadcast [nic_badress/text: card/broadcast] [nic_badress/text: "None"]
    either found? find card/flags 'multicast [nic_multi/text: "Yes" ] [nic_multi/text: "No"]
    either found? find card/flags 'point-to-point [nic_ppp/text: card/dest-addr ] [nic_ppp/text: "None"]
    show [nic_name nic_adress nic_subnet nic_badress nic_multi nic_ppp]
]
; information about this computer

HostView: layout [
    backcolor silver
    across
    origin 0x0
    at 5x5 info1: info 150 to-string host_address info2: info host_name
    at 5x30 ni_info: lbl 225 left "Network Interfaces "   ni_choice: rotary 120 silver   ""
                            [nc: to-integer face/text if nc > 0 [Get_Informations nc]]
    at 5x60 lbl 225 "Name"   left nic_name: field 120
    at 5x90 lbl 225 "Address" left nic_adress: field 120  
    at 5x120 lbl 225 "Subnet" left nic_subnet: field 120
    at 5x150 lbl 225 "Broadcast" left nic_badress: field 120
    at 5x180 lbl 225 "Multicast" nic_multi: field 120
    at 5x210 lbl 225 "Point to point" nic_ppp: field 120
]
; exploring the network via DNS

Explore_Net: does [
    if error? try [
    clear dresult/text
    dresult/line-list: none
    ;save default timeout
    Set_TimeOut 1.0
    ;get the network base address
    ipx: to-tuple dinfo1/text
    adr: ipx and 255.255.255.0
    start: now/time/precise
    append dresult/text   join "Starting exploration " newline
    show dresult
    for i 1 255 1 [
        adr: adr + 0.0.0.1
        str: join "dns://" adr
        machine: read   to-url str
        pg/text: adr pg2/data: i / 255
        ; just for the mac osx version. the delay is not necessary for linux or windows oses
        if os = "MacOSX" [wait 0.01]
        ; alive?
        if not none? machine [append dresult/text join adr [": " machine newline ] ]
        show [pg pg2 dresult ]
    ]
    end: now/time/precise
    append dresult/text join "Network scanned in " end - start
    show dresult
    ;restore default timeout
    Restore_TimeOut]
    [Alert "Error! Please use a valid IP Address!"]
]
NetView: layout [
    backcolor silver
    across
    origin 0x0
    space 5x0
    at 5x5 lbl 100 left "IP Address" dinfo1: field 175 to-string host_address
    drep1: info 175 right btn "Get" [drep1/text: "" str: "dns://" drep1/text: read to-url str show drep1]
    at 5x30 lbl 100 left "Domain Name" dinfo2: field 175 "www.rebol.net"
    drep2: info 175 right btn "Get" [drep2/text: "" adr: dinfo2/text str: str: join "dns://" adr
                                    drep2/text: read to-url str show drep2]
    space 0X0
    at 5x55 dresult: area 490x145 sl: slider 16x145 [scroll-para dresult sl]
    at 5x205   pg: info 150 pad 5 pg2: progress 225x25 pad 5 btn "Explore the Network" [Explore_Net]
]
; whois tools
WhoisView: layout [
    backcolor silver
    across
    origin 0x0
    space 5x0
    at 5x5 lbl 120 left "Domain Name" winfo1: field 355 "rebol.com"
    at 5x30 lbl 120 left "Whois Server"
    slist: Choice 250 silver "whois.internic.net" "whois.networksolutions.com" "whois.arin.net"
    btn 100 "Whois" [
            clear wresult/text
            wresult/line-list: none
            show wresult
            str: join "whois://" [winfo1/text "@" slist/text]
            if error? try [rep: read to-url str append wresult/text rep] [append wresult/text "Error in connection "]
            show wresult
   
    ]
    space 0x0
    at 5x65 wresult: area 490x170 wrap wsl: slider 16x170 [scroll-para wresult wsl]
]  
;Finger Tools

FingerView: layout [
    backcolor silver
    across
    origin 0x0
    space 0x0
    at 5x5 lbl 50 left "User" finfo1: field 150 "fjouen" txt "@" finfo2: field 200 to-string host_address
    pad 5 btn "Finger" [
            clear fresult/text
            fresult/line-list: none
            show fresult
            wait 0.01
            str: join "finger://" [finfo1/text "@" finfo2/text]
            if error? try [rep: read to-url str append fresult/text rep] [append fresult/text "Error in connection "]
            show fresult
    ]
    at 5x40 fresult: area 490x170 wrap   fsl: slider 16x170 [scroll-para fresult fsl]
]
; scan ports

ScanView: layout [
    backcolor silver
    across
    origin 0x0
    space 0x0
    at 5x5 lbl 150 left "Internet Address" sinfo1: field 215 center to-string host_address
    at 5x30 lbl 150 left "Starting Port" sinfo2: field center 70 "1"
    lbl left "Ending Port" sinfo3: field center 70 "1024" ; for standard port use
    pad 5 btn "Scan" [
        clear sresult/text
        sresult/line-list: none
        append sresult/text join "Port Scanning host: " [sinfo1/text newline]
        show sresult
        Set_TimeOut 0.1
        sstart: to-integer sinfo2/text
        send: to-integer sinfo3/text
        count: (send - sstart) + 1
        for n 1 count 1 [
                spg1/text: join "Port " n
                spg2/data: n / count
                if error? try [close open to-url join "tcp://" [sinfo1/text " :" n ]
                        append sresult/text join "Open TCP Port: "[n newline]]  
            []
            show [spg1 spg2 sresult]
            if os = "MacOSX" [wait 0.01]
            ]
            ;restore default timeout
            Restore_TimeOut
            append sresult/text "Port Scanning is done"
            show sresult
            ]
    at 5x60 sresult: area 490x150 wrap   ssl: slider 16x150 [scroll-para sresult ssl]
    at 5x215 spg1: info 150 pad 5 spg2: progress 350x25
   
]  
;ping tools

; makes ping to the host
ping: does [
    buffer: copy ""
    clear presult/text
    presult/line-list: none
    append presult/text join "Connecting host " [pinfo1/text newline]
    show presult
    commande: join "ping " ["-" countos " " pinfo2/text " " pinfo1/text]
   
    if os = "MacOSX" [wait 0.01]
    ; call external call
    call/output commande buffer
   
    append presult/text buffer
    ; for Unices OS
    n: to-integer length? buffer
    if n = 0 [append presult/text "Network Error"]
    show   presult
]
PingView: layout [
        backcolor silver
        across
        origin 0x0
        space 5x0
        at 5x5 lbl   left "Host" pinfo1: field 150 to-string host_address
        10x40 lbl "Counts" left pinfo2: field 50 "2"
        btn "Ping" [ping]
        space 0X0
        at 5x40 presult: area 490x180 wrap psl: slider 16x180 [scroll-para presult psl]
]
; Netstat tools

NetStat: does [
    buffer: copy ""
    clear nsresult/text
    nsresult/line-list: none
    append nsresult/text   join "Be patient! Connecting host " newline
    show nsresult
    switch option [
        1 [commande: "netstat -a"]
        2 [commande: "netstat -r"]
        3 [commande: "netstat -s"]
    ]
   
    if os = "MacOSX" [wait 0.01]
    ; call external call
    call/output commande buffer
    append nsresult/text buffer
   
    show   nsresult
]
NetStatView: layout [
        backcolor silver
        across
        origin 0x0
        space 5x0
        at 5x5 lbl "Display "
        nsrot: text-list 300x50   "All Information" "Routing Tables" "Protocol Statistics" [option: to-integer face/cnt]
        btn "Statistics" [NetStat]
        space 0x0
        at 5x60 nsresult: area 490x180   nssl: slider 16x180 [scroll-para nsresult nssl]
]
option: 1
deflag-face nsresult tabbed
p1/pane: hostview
update-panel p1
tmp: Get_Interfaces
if tmp > 0 [Get_Informations 1]
view center-face MainWin


Rebol 3B updates:

Rebol 3B updates:

• added Cyphre corrections to the editor
• added H1 to H5 text syles

You can easily add new text styles, just add your styles to this file: https://github.com/angerangel/r3bazaar/blob/master/builds/windows/r3-gui.r

Example:

fontize [
h1: base [
font: [
name: "Arial"
style: 'bold
size: 18
color: 0.0.0
offset: 0x0
space: 0x0
shadow: none
]
]
h2: h1 [ font: [ size: 16] ]
h3: h1 [ font: [ size: 14] ]
h4: h1 [ font: [ size: 12] ]
h5: h4 [ font: [ style: 'italic ]]
]

stylize [
h1: text [ facets: [ text-style: 'h1]]
h2: text [ facets: [ text-style: 'h2]]
h3: text [ facets: [ text-style: 'h3]]
h4: text [ facets: [ text-style: 'h4]]
h5: text [ facets: [ text-style: 'h5]]
]

Net scan

The following script is a net scan, for simple usage is faster than nmap! It calls the ping command.



Here is the source:

REBOL [
    File: %netscan.r
    Date: 17-Dec-2006
    Title: "NetScan"
    Version: 1.0
    Author: "François Jouen"
    Rights: {Copyright © EPHE 2006}
    Purpose: {How to scan a computer network with Rebol}  
    license: 'BSD
]
Quit-Requested: does [
    if (confirm/with "Really Quit ?" ["Yes" "No"]) [quit]
]
;some variables
Local_host_address: system/network/host-address
local_host_name: system/network/host
broacast_address: Local_host_address + 0.0.0.255
buffer: copy ""
;which version of os

Get_Os: does [
    switch system/version/4 [
        3 [os: "Windows" countos: "n"]
        2 [os: "MacOSX" countos: "c"]
        4 [os: "Linux" countos: "c"]
        5 [os: "BeOS" countos: "c"]
        7 [os: "NetBSD" countos: "c"]
        9 [os: "OpenBSD" countos: "c"]
        10 [os: "SunSolaris" countos: "c"]
    ]
]
;explore the network

Scan_Net: does [
    if error? try [
    stime: now/time
    status/text: "Scanning Network ...." show status
    netw/text: ""
    netw/line-list: none
    show netw
    ; first a ping test to the network broadcast address in order to refresh arp table data
    commande: join "ping " ["-" countos " " 1 " " broacast_address]
    if os = "MacOSX" [wait 0.01]
    ; call external call
    call/output commande buffer
    if os = "MacOSX" [wait 0.01]
    ; now we can use arp protocol to know the active computers
    commande: "arp -a"
    call/output commande %arp.txt
    netw/text: read/string %arp.txt
    etime: now/time
    diff: etime - stime
    status/text: join "Process completed in " diff]
    [status/text: "Error in Network scanning"]
    show [netw status]
]
Get_OS
ServerWin: layout [
    across
    space 5x5
    at 8x5
    osinfo: info os 100 center info 100 to-string Local_host_address
    btn 100 "Scan Network" [Scan_Net]
    btn 70 "Quit" [Quit-Requested]
    space 0x0
    at 5x50 netw: area 380x150 white white
    sl: slider 16x150 [scroll-para netw sl]
    at 5x205 status: info 395 ""
]
deflag-face netw tabbed
view/new center-face ServerWin
insert-event-func [
        either all [event/type = 'close event/face = ServerWin][quit-requested][event]
]
do-events


Satellite image viewer

Today I'll show you a post about a satellite viewer, how it works:

• it reads a page
• it extract satellite image url using parse
• it load also the vertical gradient bar
• it display a layout that update image every 30 minutes

and all in just 16 lines of code!


Here is the source:

REBOL [
    Title: "Gradient Colorize Examples"  
    Author:   ["Tesserator" "Massimiliano Vessi"]
    Purpose: {Trying to Auto DL weather maps on 30min. intervals from: http://wwwghcc.msfc.nasa.gov/ }
    Email: jimbo@sc.starcat.ne.jp  
]    
nasa_url:   http://wwwghcc.msfc.nasa.gov
update_img: does [
    flash "Fetching image..."
    img: read   http://weather.msfc.nasa.gov/GOES/goeseastfullir.html
    parse img [thru {TYPE="image" src="}   copy img   to {"}   to end ]
    img: load (join   nasa_url img)
    ; this way img2 is loaded just one time
    if not value? 'img2   [img2: load http://weather.msfc.nasa.gov/GOES/colorbarvert.gif ]
    unview
    ]
update_img
view layout [
    h1   "GOES East Interactive Infrared Weather Satellite Image Viewer"
    text "Image automatically updated every 30 minutes"
    across
    image img rate 00:30 feel [ engage: func [face action event] [
        update_img
        face/image: img
        show face
        ] ]
    image img2  
    ]