Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-3 of 3 total  RSS 

magic square demo

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

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

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
« Newer Snippets
Older Snippets »
Showing 1-3 of 3 total  RSS