DZone Snippets: demo code

magic square demo

gregg.irwin (Gregg Irwin) — Fri, 13 Jan 2006 04:29:02 GMT



REBOL [

    Title:  "Magic Square program"

    Author: "Gregg Irwin"

    Comment: {

        Credit to Bob Kurosaka and Martin Gardener for inspiration.

    }

]



get-size: has [result] [

    print "Enter the size of the square's side."

    print ""

    result: to-integer ask "It must be an odd number larger than 1 : "

    if any [(result < 3) (even? result)] [get-size]

    result

]



edge-guard: does [

    if row < 1    [row: row + side]

    if col > side [col: col - side]

    if row > side [row: row - side]

    if col < 1    [col: col + side]

]



print-square: func [square side] [

    print ["Magic Square, Order " side]

    print ["Each row, col, and Diagonal add up to " side * (side ** 2 + 1) / 2]

    print ""

    repeat row side [

        repeat col side [

            prin [pick square/:row col tab]

        ]

        print ""

    ]

    print ""

]





magic-square: func [/size sz [integer!]] [

    side: either size [sz][get-size]

    row: 1

    col: (side + 1) / 2         ;Locate the starting cell

    square: array/initial reduce [side side] 0

    poke square/:row col 1      ;Initialize the first value



    for i 2 to-integer (side ** 2) 1 [

        row: row - 1

        col: col + 1                  ;Northeast move

        edge-guard

        if 0 <> pick square/:row col [

            row: row + 1              ;otherwise retreat

            col: col - 1

            row: row + 1              ;Break move

            edge-guard

        ]

        poke square/:row col i

    ]

    print-square square side

]





;-- 0 based version --



; print-square: func [square side] [

;     print ["Magic Square, Order " side]

;     print ["Each row, col, and Diagonal add up to " side * (side ** 2 + 1) / 2  - side]

;     print ""

;     repeat row side [

;         repeat col side [

;             prin [pick square/:row col tab]

;         ]

;         print ""

;     ]

;     print ""

; ]

; 

; magic-square: func [/size sz [integer!]] [

;     side: either size [sz][get-size]

;     row: 1

;     col: (side + 1) / 2         ;Locate the starting cell

;     square: array/initial reduce [side side] none

;     poke square/:row col 0      ;Initialize the first value

; 

;     repeat i to-integer (side ** 2) - 1 [

;         row: row - 1

;         col: col + 1                  ;Northeast move

;         edge-guard

;         if none <> pick square/:row col [

;             row: row + 1              ;otherwise retreat

;             col: col - 1

;             row: row + 1              ;Break move

;             edge-guard

;         ]

;         poke square/:row col i

;     ]

;     print-square square side

; ]



;-- End 0 based version --



magic-square

;magic-square/size 5



halt

Pythagoras tree demo

gregg.irwin (Gregg Irwin) — Fri, 13 Jan 2006 04:27:31 GMT



REBOL [

    Title: "Tree of Pythagoras"

    Comment: {

        Based on an old E example by Raymond Hoving.

        Converted to REBOL by Gregg Irwin for testing purposes.

        Some speed mods. Pre-allocated block size, REBOLised the maths. Allen K

    }

]



pyth-tree: func [

    a[pair!] b[pair!]

    depth[integer!] face

    /local c d e color

][

    c: d: e: 0x0

    ; Darken the color slightly at each level.

    color: depth * -10 + 0.255.0

    c/x: a/x - a/y + b/y

    c/y: a/x + a/y - b/x

    d/x: b/x + b/y - a/y

    d/y: a/x - b/x + b/y

    ; Not sure where the drift comes in, but it does. I.e. the tree

    ; is asymmetrical.

    e/x: c/x - c/y + d/x + d/y * 0.5 ;+ .49999999999999

    e/y: c/x + c/y - d/x + d/y * 0.5 ;+ .49999999999999

    append draw-cmds compose [pen (color) line (c) (a) (b) (d) (c) (e) (d)]

    ;-- Uncomment the 'show and 'wait lines to see it in action.

    ;show face

    if depth < 12 [

        pyth-tree c e depth + 1 face

        pyth-tree e d depth + 1 face

    ]

    ;wait 0

]



world-size: 320x280 ;640x520

start-pt-1: 133x235 ;266x450

start-pt-2: 187x235 ;374x450



; Link/IOS seems to solve the speed problem caused by all the incremental

; allocations my original implementation caused. Version (A) lines are my

; original lines, and the (B) lines are Allen's speed mods.

lay: layout [

    size world-size

    backdrop black

    origin 0x0

    ;canvas: image 640x480 effect [draw []]  ;(A)

    canvas: image 320x240   ;(B)

    across

    button "go" [

        clear draw-cmds

        show canvas

        ;print now/precise

        pyth-tree start-pt-1 start-pt-2 0 canvas

        ;print now/precise

        show canvas

    ]

    button "quit" [quit]

]

;draw-cmds: second canvas/effect ;(A)

; preallocate the space needed

canvas/effect: reduce ['draw draw-cmds: make block! 90000]  ;(B)



;print ""

view lay

spirograph demo

gregg.irwin (Gregg Irwin) — Fri, 13 Jan 2006 04:26:34 GMT



REBOL [

    Title:  "Simple Spirograph"

    Author: "Gregg Irwin"

    EMail:  greggirwin@acm.org



    Comment: {

        Set max number of lines

        Generate random start point and velocity

        at each iteration

            for each set

                calculate next set of end-points from previous end-points

                append line command to draw effect, wrap if at max-lines



        TBD

            Allow for multiple line "sets".

            Figure out why it's so slow for large canvases.

            Use color-shifting lines, rather than restarting with a new color.

    }

]



num-lines: 30   ; change this for longer, or shorter, line sets.

end-points: make block! 128

pt-1: pt-2: 0x0

delta-1: delta-2: 0x0

direction-1: direction-2: 'SE

color: 0.0.0



directions: [

    SE   1x1

    NW  -1x-1

    NE   1x-1

    SW  -1x1

]



initialize: func [

    "Initialize starting coordinates, directions, and colors."

    face

    i [integer!]

][

    random/seed now

    ; Starting locations for line end points

    pt-1: random face/size

    pt-2: random face/size

    change/only at end-points i [pt-1 pt-2]

    ; Direction of travel

    direction-1: pick [SE NW NE SW] random 4

    direction-2: pick [SE NW NE SW] random 4

    ; Angle of travel. Bigger numbers move things faster.

    ;delta-1: 2 + (random 3x3)

    ;delta-2: 2 + (random 3x3)

    delta-1: random 3x3

    delta-2: random 3x3

    ; Colors. The + 32 keeps it from being too dark.

    color: (random 200.200.200) + 32

]



move-points: func [face] [

    ; direction-1 = Direction of Travel for Point 1

    ; direction-2 = Direction of Travel for Point 2



    ;TBD Should be able to map these so the code isn't duped for each point.

    pt-1: pt-1 + (delta-1 * (select directions direction-1))

    switch direction-1 [

        NE [if pt-1/x > face/size/x [direction-1: 'NW]

            if pt-1/y < 1 [direction-1: 'SE]]

        SE [if pt-1/x > face/size/x [direction-1: 'SW]

            if pt-1/y > face/size/y [direction-1: 'NE]]

        SW [if pt-1/x < 1 [direction-1: 'SE]

            if pt-1/y > face/size/y [direction-1: 'NW]]

        NW [if pt-1/x < 1 [direction-1: 'NE]

            if pt-1/y < 1 [direction-1: 'SW]]

    ]



    pt-2: pt-2 + (delta-2 * (select directions direction-2))

    switch direction-2 [

        NE [if pt-2/x > face/size/x [direction-2: 'NW]

            if pt-2/y < 1 [direction-2: 'SE]]

        SE [if pt-2/x > face/size/x [direction-2: 'SW]

            if pt-2/y > face/size/y [direction-2: 'NE]]

        SW [if pt-2/x < 1 [direction-2: 'SE]

            if pt-2/y > face/size/y [direction-2: 'NW]]

        NW [if pt-2/x < 1 [direction-2: 'NE]

            if pt-2/y < 1 [direction-2: 'SW]]

    ]



]



do-spiro: func [

    face

    max-interval [time!]

    /local i t interval

][

    i: j: 0

    t: now/time/precise

    interval: 0:0:3 + random max-interval

    initialize face i

    forever [

        if now/time/precise > (t + interval) [

            clear draw-cmds

            interval: 0:0:3 + random max-interval

            t: now/time/precise

            initialize face i

            wait .05

        ]



        append draw-cmds compose [pen (color) line (pt-1) (pt-2)]

        ; Erase oldest line

        if (length? draw-cmds) > (num-lines * 5) [

            remove/part head draw-cmds 5

        ]



        ;print mold draw-cmds

        move-points face

        i: either i < 127 [i + 1][0]

        j: either j < 127 [j + 1][0]



        show face

        ; wait 0 isn't as system friendly as wait .001, but it's faster.

        wait 0 ;.001

    ]

]



lay: layout [

    origin 0x0

    backdrop black

    ; Using a larger canvas really slows things down

    ;canvas: image black 640x480

    canvas: image black 320x240

    across

    button "go" [do-spiro canvas 0:0:10]

    button "quit" [quit]

]

canvas/effect: reduce ['draw draw-cmds: make block! (num-lines * 5)]



view lay

;view/offset lay 0x0