[REBOL] Re: Text Area scroll.

From: g:santilli:tiscalinet:it at: 10-Dec-2003 17:26

Hi Carlos,

On Tuesday, December 9, 2003, 1:24:50 PM, you wrote:

CL> I remember last time I asked here just the same
CL> and unfortunately I got only one reply from the list
CL> that didn't solve the problem at all.

So everyone forgot about the EVOScript? ;-)

Regards,
   Gabriele.
--
Gabriele Santilli <[g--santilli--tiscalinet--it]>  --  REBOL Programmer
Amiga Group Italia sez. L'Aquila  ---   SOON: http://www.rebol.it/

REBOL [
    Title: "Evolving Script"
    Date: 25-Nov-2002/21:38:29+1:00
    Name: none
    Version: 1.31.0
    File: %evoscript.r
    Home: none
    Author: "Gabriele Santilli"
    Owner: none
    Rights: none
    Needs: [view 1.2.8]
    Tabs: none
    Usage: none
    Purpose: "To make the definitive quine!"
    Comment: "This can be addictive. You have been warned."
    History: [not yet implemented]
    Language: "English"
    Type: 'Script
    Content: true
    Layout: [
        Do [trebuchet: [name: "Trebuchet MS" size: 14]]
        Style Button Btn font trebuchet font-size 16 bold -1x28

        Banner center 600 font trebuchet font-size 38 bold yellow "The REBOL evolving script"
        Text right 600 font trebuchet font-size 16 "by Gabriele Santilli"

        Pad -10 Text right 600 font trebuchet italic "(original idea by Baron R.K. Von Wolfsheild)"
        Text 600 font trebuchet

        {Maybe I'm just crazy, but this is so much fun! It is amazing to see how easy I can be 
        amazed by these short things... I wonder if any other language could do this in so few 
        lines of code, and with this readability...}
        Across

        a: Area para [scroll: either value? 'remember-scroll [remember-scroll] [0x0]] font trebuchet 
        583x300 system/script/header/content feel [
            engage': :engage
            last-scroll: none
            engage: func [face action event] [
                engage' face action event
                if all [event/type = 'key face/para/scroll/y <> last-scroll] [
                    last-scroll: face/para/scroll/y
                    rescroll
                ]
            ]
        ]
        Pad -8 s: Scroller 17x300 [
            tsize: size-text a
            a/para/scroll/y: 280 - tsize/y * face/data
            show a
        ]
        do [rescroll]
        Return
        Button "Update Layout" 255.200.50 [
            attempt [
                attempt [

                    set reduce [in system/script 'header 'content] load/header/next a/text
                    system/script/header/date: now

                    system/script/header/version: system/script/header/version + 0.1.0
                    system/script/header/content: join "REBOL " [
                        find mold make system/script/header [content: true] "["
                        content
                    ]
                ]
                remember-scroll: a/para/scroll
                lay2: system/words/layout system/script/header/layout
                lay/pane: lay2/pane
                lay/size: lay2/size
                show lay
                lay/text: system/script/header/title
                lay/changes: 'text
                show lay
            ]
        ]
        Button "Copy Script" [
            write clipboard:// system/script/header/content
        ]
        Button "Save Script" 50.240.100 [
            write system/script/header/file system/script/header/content
            do system/script/header/file
            "This is a bug in VIEW..."
            lay/feel: system/view/window-feel
        ]
        Button "Send to [giesse--rebol--it]" [

            send/subject [giesse--rebol--it] system/script/header/content join "[EVOScript] " system/script/header/title
        ]
        Return
        Button "Pretty-print" [
            pretty-print
        ]
    ]
]

pretty-print: does [
    attempt [
        set reduce [ in system/script 'header 'content ] load/header/next a/text
        a/text: system/script/header/content: join "REBOL " [
            find mold make system/script/header [ content: true ] "["
            mold/only/all load content
        ]
        show a
    ]
]

if exists? %clean-script.r [
    do %clean-script.r
    pretty-print: does [
        a/text: system/script/header/content: detab clean-script/spacey a/text
        show a
    ]
]

rescroll: func [ /only ] [
    tsize: size-text a
    if not only [ s/redrag min 1 a/size/y - 15 / tsize/y ]
    s/data: min 1 max 0 a/para/scroll/y / ( a/size/y - 15 - tsize/y )
    show s
]

system/view/window-feel/detect: func [ face event ] [
    if event/type = 'scroll-line [
        a/para/scroll/y: event/offset/y * -15 + a/para/scroll/y
        show a
        rescroll/only
    ]
    event
]

view lay: layout system/script/header/layout

1 · 2 · 3 · 4 · 5 · [6] · 7 · 8 · 9 · See whole thread