• Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

World: r4wp

[Rebol School] REBOL School

Steeve
5-Oct-2012
[1181x4]
; Sorry Ladislav I've stolen your idea one should avoid catch/throw 
interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
; Ladislav I can't see if you posted new code (WTF Altme)

; So I've tried your idea one should avoid catch/throw interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
; Ladislav I can't see if you posted new code (WTF Altme)

; So I've tried your idea one should avoid catch/throw interferences

; As an extra (also your idea ?), f/recur and recur are now both 
allowed.

rfunc: func [[catch] spec [block!] body [block!] /local ctx fun][
    ctx: bind? take second fun: throw-on-error [
        func append copy spec /recur reduce ['recur body]
    ]
    insert second :fun reduce [

        quote #[function! [[throw] ctx args 'fun body /local ret][

            if :ctx/recur [ctx/recur: ctx throw/name second ctx 'recur]
            ctx/recur: :fun
            while [true][
                set/any 'ret catch/name [return do body] 'recur

                unless all [value? 'ret block? :ret same? ctx last ret][
                    throw/name get/any 'ret 'recur
                ]
                set/any args ret
            ]
        ]]

        ctx (bind head remove back tail to-block form first ctx ctx) :fun
    ]
    :fun
]
About the #[function!] vs func equivalence.

It's not. The first one is a singleton, meaning only one version 
exists in memory (not recreated each time)
BrianH
5-Oct-2012
[1185]
You can build that singleton when rfunc is called initially, or if 
you only need one then you can use funct/with to make a static local 
var with that value. (Still haven't analyzed the source.)
Ladislav
5-Oct-2012
[1186x2]
However, Steeve, you probably do not understand what the problem 
with the

    f: rfunc [x] [if x = 2 [g/recur 3 5]]


code is. The problem in a nutshell is that the G/RECUR call uses 
G/RECUR calling convention and "expects" the G/RECUR call to be used; 
however, the CATCH/NAME+THROW/NAME pair does not respect that and 
actually would do the call of F/RECUR.
(with a possibly incompatible calling convention)
Steeve
5-Oct-2012
[1188]
This time it's really really my final version T_T
- Both f/recur and recur allowed
- Catch/throw interferences ok.

NB: The code would be simpler in R3 since several workarounds are 
used to correct misbehaviors of object related natives of R2.

Also the lack of the reflexive capability for a function to read 
its own context in a easy way is definitivly a huge miss.

(On can't create anonymous functions without analysing their specs 
first. What a pain)

One would need a reserved word holding the context (like SELF for 
objects).

These shortcomings are making the code too much obfuscated and huge 
for my taste.
I hope it will be corrected in R3..

rfunc: func [
    [catch] spec [block!] body [block!] 
    /local ctx args call-tail
][
    ctx: bind? first second throw-on-error [
        func spec: append copy spec /recur [recur]
    ]
    args: bind head remove back tail to-block form first ctx ctx
    call-tail: func ['word] compose/deep [
        set/any [(args)] second bind? word 
        throw/name (ctx) 'recur
    ]
    ctx/recur: func spec reduce [:call-tail 'recur]
    func spec reduce [
        quote #[function! [
            [throw] 'recur 'call-tail ctx args body /local ret
        ][
            if get/any recur [call-tail :recur]
            set recur get in ctx 'recur
            while [true][
                set/any 'ret catch/name [return do body] 'recur
                unless all [value? 'ret same? :ret ctx][
                    throw/name get/any 'ret 'recur
                ]
                set/any args second ctx
            ]
        ]]
        'recur :call-tail ctx args body
    ]
]
Steeve
7-Oct-2012
[1189]
(test sync)
Arnold
7-Oct-2012
[1190]
VID question. Is it possible to combine more than 1 fontsize, color 
within the text on a element like a label? I want to emphasize a 
small piece of the text.
Gregg
7-Oct-2012
[1191]
You have to use DRAW commands to do it in R2.
Henrik
7-Oct-2012
[1192]
and then you lose text adjustment control
Arnold
7-Oct-2012
[1193]
That is a idea. The text to emphasize is the text that you get to 
read. Then it disappear and you have to type it yourself. It is a 
progam from a schoolprogram for young children. I want to replicate 
it and maybe add a little fun for my daughter thinks it is boring 
as it is now.
Henrik
7-Oct-2012
[1194x2]
it's also possible to simply add a pane of faces that construct the 
text in the necessary parts. with SIZE-TEXT you can then calculate 
the necessary size of each part and write a little routine to lay 
it out. it's a bit of work, though.
that does not use DRAW.
Sunanda
7-Oct-2012
[1196]
Does this get close?
   http://www.rebol.org/view-script.r?script=render-rich-text.r
MaxV
8-Oct-2012
[1197]
WOW it's amazing!
Arnold
8-Oct-2012
[1198x2]
I tested this on my Macbook just now and only the blue link is specially 
rendered. Functional though, it does send me to the designated page 
in Safari.
Henrik, my initial idea was that it should be possible to make such 
a text/label facet where the text and markup are stored in array/blocks. 
The markup could just be a referral to a markup defined elsewhere. 
Not that I am afraid of a little work but right now I think I can 
manage what I want using just a new textcolor ;)


I named my Text+ field piep and calculated size-text piep to be 0x15. 
Doesn't look correct. Also "word' url" should be "word 'url" in render-rich-text 
/local declaration?
Henrik
8-Oct-2012
[1200]
I usually use a test face first for SIZE-TEXT. It's important that 
the test face has the dimensions to at least contain the text, as 
you want it formatted. When you then use that face as an argument 
to SIZE-TEXT, it returns the face size. That face size can then be 
used to set the size of the real text face.
Arnold
8-Oct-2012
[1201]
good tip. thnx!
Sujoy
10-Oct-2012
[1202x6]
hi everyone. 
as usual, i need some help.
i'm trying to use Doc's uniserve+taskmaster engine
i read on altme that i should be using the version from the cheyenne 
sources
so i copied the files over to a new directory, then when i try
>> do %uni-engine.r
>> uniserve/boot
...i get a bunch of errors saying cheyenne is not defined


using the old (0.99) sources on the softinnov website, i can use 
the starter.r script just fine. However, i set up a simple service 
and a module to process tasks, but get:

** Script Error: Cannot use path on none! value
** Where: process-task
** Near: if shared/pool-max > shared/pool-count [
    fork
    if verbose > 0 [log/info "launching new process"]
]
the service is a simple test:

install-service [
  name: 'test
  port-id: 9000
  module: 'my-module

  on-load: func[] [
    do %scheduler.r
    scheduler/plan [every 10 s do my-func]
    scheduler/wait
  ]
  on-task-done: func[data] [print data]
  my-func: func[][
    data: load datafile
    foreach [key value] data [
      shared/do-task [value] self
    ]
  ]
]
the module:

install-module [
  name: 'my-module
  on-task-received: func[data][
    response: rejoin["got" data]
  ]
]
i'm probably being totally obtuse...any help greatly appreciated
DocKimbel
10-Oct-2012
[1208x2]
Hi Sujoy, glad you're using Uniserve. You should use the latest version 
from Cheyenne. Some services or client protocols might be dependent 
on Cheyenne, so the best thing to do is move them out of %services/ 
and %protocols/ folder and leave only your own ones. Also by default, 
the task hander module should go in a %UniServe/handlers/ folder.
Also, you need to set the UniServe path variable before loading it:

    uniserve-path: <path-to-your-uniserve-folder>
Sujoy
10-Oct-2012
[1210]
Thanks for getting back to me on this Doc...
So if i have this correct, I should:
1. Use the latest version from Cheyenne (have made a copy)

2. Remove all services and protocols from the %services/ and %protocols/ 
folders, except for task-master.r (which i need!)

3. Now hopelessly confused - the UniServe directory tree of the latest 
Cheyenne version I have is as follows:
     Uniserve
     ---clients
     ---libs
     ---protocols
     ---services
         ---task-master.r
         ---task-master
             ---task-handler.r
     I don't see a %UniServe/handlers folder...
DocKimbel
10-Oct-2012
[1211]
You have to add it back, it has been moved to %cheyenne/ folder.
Sujoy
10-Oct-2012
[1212]
ah - ok. i was trying to create a %MODULES folder
give me a minute...
DocKimbel
10-Oct-2012
[1213]
After removing all unnecessary UniServe plugins, this sequence works 
for me:

    uniserve-path: %//dev/cheyenne-server/uniserve/
    do uniserve-path/uni-engine.r
    uniserve/boot
Sujoy
10-Oct-2012
[1214x3]
uniserve/boot works fine after these steps, but...

** Script Error: Cannot use path on none! value
** Where: process-task
** Near: if any [
    zero? shared/pool-max
    shared/pool-max > shared/pool-count
] [fork]
either
(am on windows)
am using the same test i put into altme for the service and module...
DocKimbel
10-Oct-2012
[1217]
Can you send me a zip of your Uniserve folder so I can test that 
locally?
Sujoy
10-Oct-2012
[1218x3]
sure
unfortunately, i dont have permissions to send files over altme. 
:(
how else can i send? email?
have sent you a mail at nr at red-lang dot org
DocKimbel
10-Oct-2012
[1221]
Ok, from the UniServe folder, this code works:

    uniserve-path: %./
    do %uni-engine.r
    uniserve/boot

I had to change your absolute path in %reminder.r to:

- line 11:   do uniserve-path/libs/scheduler.r
- line 24:   feeds: load uniserve-path/docs/feeds.r
Sujoy
10-Oct-2012
[1222x2]
trying this right now...
damn! no luck.

>> ls
BSD-License.txt  change-log.txt   clients/         docs/
handlers/        libs/            protocols/       services/
uni-engine.r
>> uniserve-path: %./
== %./
>> do %uni-engine.r
Script: "UniServe kernel" (17-Jan-2010)
Script: "Encap virtual filesystem" (21-Sep-2009)
== true
>> uniserve/boot
booya
.

http://newsrss.bbc.co.uk/rss/newsonline_uk_edition/business/rss.xml
** Script Error: Cannot use path on none! value
** Where: process-task
** Near: if any [
    zero? shared/pool-max
    shared/pool-max > shared/pool-count
] [fork]
either
DocKimbel
10-Oct-2012
[1224]
Ah, I stopped at "booya". :-)
Sujoy
10-Oct-2012
[1225x2]
:)
is this because pool-list is empty?

i put in a debug "print" cmd in the on-new-client function of task-master.r, 
which is the only place i could see pool-list being appended to...but 
it seems the function is not called
on-new-client: has [job][
  ;added this line
  print client/remote-ip
  if client/remote-ip <> 127.0.0.1 [close-client exit]
  set-modes client [keep-alive: on]
  client/timeout: 15
  client/user-data: make task []
  ;only place where pool-list is appended to...
  append pool-list :client
DocKimbel
10-Oct-2012
[1227]
No the issue is with 'shared being reset to 'none in %task-master...looks 
like a regression in Uniserve when working on standalone...I'm looking 
into it.
Sujoy
10-Oct-2012
[1228]
thanks doc!
DocKimbel
10-Oct-2012
[1229]
In %reminder.r, you shouldn't use: scheduler/wait. Uniserve is already 
providing an event loop. You need to remove that line.
Sujoy
10-Oct-2012
[1230]
ok...