Skip to content

Instantly share code, notes, and snippets.

@luce80

luce80/Mini_Red_tools.red

Last active April 29, 2024 16:46
Show Gist options
  • Save luce80/1b1119fa7dc856cc36a34e1b7f8a2a8e to your computer and use it in GitHub Desktop.
Save luce80/1b1119fa7dc856cc36a34e1b7f8a2a8e to your computer and use it in GitHub Desktop.
Download ZIP
Some useful mini Red scripts and a script to group them all.
Raw
livecode_draw.red
Red [Needs: 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
Title: "Simple DRAW livecoding"
Author: @luce80
File: %livecode_draw.red
Needs: 'View
Usage: {
Directly derived from %livecode.red author: @dockimbel
Type draw code in the left area, you will see the resulting image
rendered live on the right side.
}
Tabs: 4
version: 0.0.4
history: [
0.0.0 [15-08-2022 "Started"]
0.0.1 [17-10-2022 "Something happens"]
0.0.3 [24-02-2024 "Transformed into a module of Mini_edit_do"]
0.0.4 [07-04-2024 "Fixed 'form-short-error'"]
]
type: none ;'module ; TBD
import-gists: [ ; TBD
'action-requesters.red/action-requesters.red
'red-vid-styles.red/area-plus.red
'red-vid-styles.red/splitter.red
]
import-local: [ ; TBD
%gui/action-requesters.red
%gui/widgets/area-plus.red
%gui/widgets/splitter.red
]
]
probedo: func [code [block!] /local result][print [mold code mold/only result: reduce code] do :result]
; module
undirize: func [
"Returns a copy of the path turned into a file."
path [file! url! string!]
][
path: copy path
while [find "/\" path: back tail path] [remove path]
head path
]
read-gist: func [
"Returns a Gist from GitHub, or none"
id [issue!]
filename [string! any-word! file!]
/local gists
][
gists: load/as rejoin [https://api.github.com/gists/ id] 'json
attempt [gists/files/(to word! to string! filename)/content]
]
load-script-thru-gists: function [
"Read a @luce80 gist"
gist [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! gist
;?? gist
if (length? gist) > 2 [do make error! "Wrong path"]
if cache [
cached: cache/(undirize to file! gist/2)
if string? cached: attempt [read cached] [return cached]
]
issue: any [select [
red-vid-styles.red #433286c66d98997aff6e69fbd6323a35
action-requesters.red #89be16a8d0a3031b41cc49795e6e20b4
;mini-tools
] gist/1
#433286c66d98997aff6e69fbd6323a35] ; red-vid-styles.red
read-gist issue gist/2
]
;
; import
system/script/header/type: none
caching: %.
if system/script/args <> "" [
do system/script/args
system/script/header/type: type
]
get-module: function [
"Do a @luce80 module"
path [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [return true] ; avoid reloading
file: load-script-thru-gists/cached path cache
either file [do file true][false]
]
view/no-wait w1: layout [text font-size 20 "Downloading widgets..."]
ok?: all [
get-module/cached 'action-requesters.red/action-requesters.red caching
;get-module/cached 'red-vid-styles.red/area-plus.red caching/widgets ;@@ obsolete ;)
get-module/cached 'red-vid-styles.red/area-rt.red caching/widgets
get-module/cached 'red-vid-styles.red/splitter.red caching/widgets
get-module/cached 'red-vid-styles.red/scrollable-panel.red caching/widgets/scroller
get-module/cached 'red-vid-styles.red/spinner-panel.red caching/widgets
]
unview/only w1
;
either not ok? [view [below center text font-size 20 font-color red "Couldn't open or download widgets..." button "OK" [unview]]
ok? ; returned from script
][
; do the rest of the script
livecode_draw.red-ctx: context [
; file
saved?: yes
named?: false
job-name:
code:
none
change_title: func [/modified] [
clear any [find/tail main-window/text "- " main-window/text]
if any [modified not saved?] [append main-window/text "*" saved?: no]
append main-window/text to-string last split-path any [job-name %Untitled]
]
open_file: func [/local file-name job] [
until [
file-name: request-file/title "Load a text file with Draw commands"
if none? file-name [return none]
exists? file-name
]
job-name: file-name
job: read file-name
code: copy job
named?: yes
mif/source/clear-text
mif/source/insert-text job 1
update
saved?: yes
change_title
job
]
save_file: func [job [string!] /as /local file-name filt ext response] [
if all [empty? job not confirm "Save an empty file?"] [return false]
if not named? [as: true]
if as [
ext: %.r
file-name: request-file/title/save "Save as text file"
if none? file-name [return false]
;if not-equal? suffix? file-name ext [append file-name ext]
response: true
if exists? file-name [response: confirm rejoin [{File "} last split-path file-name {" already exists, overwrite it?}]]
if response <> true [return false]
job-name: file-name
named?: yes
]
flash append copy "Saving to: " to-local-file job-name
write job-name job
wait 1
unview
saved?: yes
change_title
true
]
undo: does [
mif/source/undo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
update
]
redo: does [
mif/source/redo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
update
]
; update, do-actor
update: does [
do-actor mif/source none 'key-up
;show mif/source
]
do-actor: func [
"Internal Use Only"
face [object!] event [event! none!] type [word!]
/local result act name
][
if all [
object? face/actors
act: in face/actors name: any [select system/view/evt-names type type]
act: get act
] [
if debug-info? face [print ["calling actor:" name]]
set/any 'result do-safe [act face event]
]
:result
]
; error
form-short-error: function [
"Forms a one line error message from an error!"
err [error!]
][;derived from 11-Feb-2007 Guest2
arg1: any [attempt [:err/arg1] 'unset]
arg2: any [attempt [:err/arg2] 'unset]
arg3: any [attempt [:err/arg3] 'unset]
message: system/catalog/errors/(err/type)/(err/id)
unless string? message [
message: bind to-block message 'err
]
rejoin ["** " system/catalog/errors/(err/type)/type ": " trim/with trim/lines mold/only reduce message {"}]
]
;
; GUI
main-window: none
system/view/VID/styles/textmin: [template: [type: 'text size: 0x0]]
MIF: object [ ;; My Important Faces , idea taken from @dsunanda
button-open:
button-save:
text-error:
source:
output:
none
]
win: layout compose/deep [
title (system/script/header/title)
;title "Simple DRAW livecoding"
;title (select select load system/options/script 'Red 'title)
live-draw-ctx-spl: splitter [ ; @@ I cannot overwrite on-create nor on-created :( therefore I am giving a "unique" name
origin 0x0 space 0x4
below
spinner-panel [
origin 0x0 space 4x4
button "&Open..." [open_file] ON-CREATED [mif/button-open: face]
button "&Save" [save_file mif/source/text] ON-CREATED [mif/button-save: face]
pad -6x0
button "as..." 40 [save_file/as mif/source/text]
button "Undo" [undo]
button "Redo" [redo]
button "Clear Draw" [if confirm "Are you sure?" [clear mif/source/text update change_title/modified]]
]
live-draw-ctx-sp: scrollable-panel [ ; @@ I cannot overwrite on-create nor on-created :( therefore I am giving a "unique" name
splitter [origin 0x0 space 0x4
below
text "OK" leaf white bold font-size 12 ON-CREATED [mif/text-error: face]
splitter [origin 0x0 ;space 7x4
splitter [origin 0x0 space 0x2
below
textmin bold " Draw block" no-wrap ; @@ must use spaces to move text :(
area-rt 200x400 focus {pen leaf^/fill-pen orange^/circle 30x30 20^/}
font-name system/view/fonts/fixed
ON-CREATED [mif/source: face]
ON-KEY-UP [
mif/output/data: mif/output/draw
;if not word? event/key [
either error? set/any 'err try [
draw 1x1 ;@@ using BUG workaround by @hiianboris
mif/output/draw: compose/deep load mif/source/text
] [
mif/text-error/color: red + 0.20.20
mif/text-error/text: form-short-error err
mif/output/draw: mif/output/data
][
mif/text-error/color: leaf
mif/text-error/text: "OK"
show mif/output
]
show mif/text-error
;]
]
ON-CHANGE [change_title/modified]
] options [flags: [first-fixed undraggable]]
splitter [origin 0x0 space 0x2
below
textmin bold " Drawings"
base 400x400 white ;draw load mif/source/text
ON-CREATED [
mif/output: face
face/draw: load mif/source/text
]
] options [flags: [first-fixed undraggable]]
] options [flags: [separator]]
] options [flags: [first-fixed undraggable]]
] options [min-child-size: 600x400] ; scrollable-panel
] options [flags: [first-fixed undraggable] first-min-size: 24]
]
main-window: win ; used by change_title
;
] ; context
if system/script/header/type <> "module" [ ; were we started directly?
;if system/script/title = none [
;print "" ; open console for debug
;wait 1 loop 10 [do-events/no-wait] ; flush key events used to launch Red.exe !!? to see when om-key-up is called
view/flags/options livecode_draw.red-ctx/win 'resize [
actors: object [
on-key: func [face event] [;probedo [event/key]
switch event/key [
#"^O" [do-actor live-draw-ctx/mif/button-open none 'click]
#"^S" [do-actor live-draw-ctx/mif/button-save none 'click]
]
]
on-create: func [face][face/data: face/size] ; init value
on-focus: func [face event][face/data: face/size] ; store old size
on-resize: func [face event][face/actors/on-resizing face event] ; forward
on-resizing: func [face event /local siz][
siz: face/size - face/data ; compute size difference
face/data: face/size ; store new size
live-draw-ctx-spl/size: live-draw-ctx-spl/size + (siz * 1x1)
if not system/view/auto-sync? [show live-draw-ctx-spl]
]
]
]
]; if ourselves
livecode_draw.red-ctx/win/pane ; returned from script
] ; either ok?
Raw
livecode_VID.red
Red [Needs: 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
Title: "Simple VID livecoding demo"
Author: @luce80
File: %livecode_VID.red
Needs: 'View
Usage: {
Directly derived from %livecode.red author: @dockimbel
Type VID code in the left area, you will see the resulting GUI
rendered live on the right side.
}
Tabs: 4
version: 0.0.4
history: [
0.0.0 [18-08-2022 "Started"]
0.0.1 [09-10-2022 "Something happens"]
0.0.3 [24-02-2024 "Transformed into a module of Mini_edit_do"]
0.0.4 [07-04-2024 "Fixed 'form-short-error'"]
]
]
; module
undirize: func [
"Returns a copy of the path turned into a file."
path [file! url! string!]
][
path: copy path
while [find "/\" path: back tail path] [remove path]
head path
]
read-gist: func [ ;https://api.github.com/users/luce80/gists
"Returns a Gist from GitHub, or none"
id [issue!]
filename [string! any-word! file!]
/local gists
][
gists: load/as rejoin [https://api.github.com/gists/ id] 'json
attempt [gists/files/(to word! to string! filename)/content]
]
load-script-thru-gists: function [
"Read a @luce80 gist"
gist [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! gist
;?? gist
if (length? gist) > 2 [do make error! "Wrong path"]
if cache [
cached: cache/(undirize to file! gist/2)
if string? cached: attempt [read cached] [return cached]
]
issue: any [select [
red-vid-styles.red #433286c66d98997aff6e69fbd6323a35
action-requesters.red #89be16a8d0a3031b41cc49795e6e20b4
] gist/1
#433286c66d98997aff6e69fbd6323a35] ; red-vid-styles.red
;?? issue
read-gist issue gist/2
]
;
; import
system/script/header/type: none
caching: %.
if system/script/args <> "" [
do system/script/args
system/script/header/type: type
]
get-module: function [
"Do a @luce80 module"
path [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [return true] ; avoid reloading
file: load-script-thru-gists/cached path cache
either file [do file true][false]
]
view/no-wait w1: layout [text font-size 20 "Downloading widgets..."]
ok?: all [
get-module/cached 'action-requesters.red/action-requesters.red caching
;get-module/cached 'red-vid-styles.red/area-plus.red caching/widgets ;@@ obsolete ;)
get-module/cached 'red-vid-styles.red/area-rt.red caching/widgets
get-module/cached 'red-vid-styles.red/splitter.red caching/widgets
get-module/cached 'red-vid-styles.red/scrollable-panel.red caching/widgets/scroller
get-module/cached 'red-vid-styles.red/spinner-panel.red caching/widgets
]
unview/only w1
;
either not ok? [view [below center text font-size 20 font-color red "Couldn't open or download widgets..." button "OK" [unview]]
ok? ; returned from script
][
; do the rest of the script
livecode_VID.red-ctx: context [
; file
saved?: yes
named?: false
main-window:
job-name:
code:
none
change_title: func [/modified] [
clear any [find/tail main-window/text "- " main-window/text]
;either modified [append main-window/text "*" saved?: no][saved?: yes]
if any [modified not saved?] [append main-window/text "*" saved?: no]
append main-window/text to-string last split-path any [job-name %Untitled]
]
open_file: func [/local file-name job] [
until [
file-name: request-file/title "Load a text file with VID commands"
if none? file-name [return none]
exists? file-name
]
job-name: file-name
job: read file-name
code: copy job
named?: yes
mif/source/clear-text
mif/source/insert-text job 1
update
saved?: yes
change_title
job
]
save_file: func [job [string!] /as /local file-name filt ext response] [
if all [empty? job not confirm "Save an empty file?"] [return false]
if not named? [as: true]
if as [
;ext: %.r
file-name: request-file/title/save "Save as text file"
if none? file-name [return false]
;if not-equal? suffix? file-name ext [append file-name ext]
response: true
if exists? file-name [response: confirm rejoin [{File "} last split-path file-name {" already exists, overwrite it?}]]
if response <> true [return false]
job-name: file-name
named?: yes
]
flash append copy "Saving to: " to-local-file job-name
write job-name job
wait 1
unview
saved?: yes
change_title
true
]
undo: does [
mif/source/undo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
;apply 'change_title/:modified [strict-equal? code mif/source/text]
update
]
redo: does [
mif/source/redo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
update
]
;
; update, do-actor
update: does [
do-actor mif/source none 'key-up ; re-calc and refresh
;show mif/source
]
do-actor: func [
"Internal Use Only"
face [object!] event [event! none!] type [word!]
/local result act name
][
if all [
object? face/actors
act: in face/actors name: any [select system/view/evt-names type type]
act: get act
] [
if debug-info? face [print ["calling actor:" name]]
set/any 'result do-safe [act face event]
]
:result
]
;
; error
form-short-error: function [
"Forms a one line error message from an error!"
err [error!]
][;derived from 11-Feb-2007 Guest2
arg1: any [attempt [:err/arg1] 'unset]
arg2: any [attempt [:err/arg2] 'unset]
arg3: any [attempt [:err/arg3] 'unset]
message: system/catalog/errors/(err/type)/(err/id)
unless string? message [
message: bind to-block message 'err
]
rejoin ["** " system/catalog/errors/(err/type)/type ": " trim/with trim/lines mold/only reduce message {"}]
]
;
;print "" ; open console for debug
; GUI
MIF: object [ ;; My Important Faces , idea taken from @dsunanda
button-open:
button-save:
text-error:
source:
output:
none
]
system/view/VID/styles/textmin: [template: [type: 'text size: 0x0]]
gui: {text "Hello World!"^/button "OK" [alert "All right"]^/}
err: none
pane: none
do-pos: none ; position of "do [...]"
syswords: [do bind _ system/words]
win: layout compose/deep/only [
title (system/script/header/title)
;title "Simple VID livecoding demo"
;title (select select load system/options/script 'Red 'title)
live-vid-ctx-spl: splitter [ ; @@ I cannot overwrite on-create nor on-created :( therefore I am giving a "unique" name
origin 0x0 space 0x4
below
spinner-panel [
origin 0x0 space 4x4
button "&Open..." [open_file] ON-CREATED [mif/button-open: face]
button "&Save" [save_file mif/source/text] ON-CREATED [mif/button-save: face]
pad -6x0
button "as..." 40 [save_file/as mif/source/text]
button "Undo" [undo]
button "Redo" [redo]
button "Clear VID" [if confirm "Are you sure?" [mif/source/clear-text update change_title/modified]]
]
live-vid-ctx-sp: scrollable-panel [ ; @@ I cannot overwrite on-create nor on-created :( therefore I am giving a "unique" name
splitter [origin 0x0 space 0x4
below
text "OK" leaf white bold font-size 12 ON-CREATED [mif/text-error: face]
splitter [origin 0x0 ;space 0x0
splitter [origin 0x0 space 0x2
below
textmin bold " VID block" no-wrap ; @@ must use spaces to move text :(
area-rt 400x400 focus (;trim-auto
gui) font-name system/view/fonts/fixed font-size 10
ON-CREATED [mif/source: face]
ON-KEY-UP [
if any [none? event not word? event/key] [
either error? set/any 'err try/all [
pane: compose to-block load mif/source/text ; to-block used only because there can be only one word !
if do-pos: find/tail pane 'do [ ; FIXME: make this user settable
change/only at syswords 3 do-pos/1
change/only do-pos syswords
]
mif/output/color: attempt [to tuple! do select pane 'backdrop] ; FIXME: not bullet-proof
mif/output/pane: layout/only pane
] [
mif/text-error/color: red + 0.50.50
mif/text-error/text: form-short-error err
][
mif/text-error/color: leaf
mif/text-error/text: "OK"
show mif/output
]
show mif/text-error
]
]
ON-CHANGE [change_title/modified]
] options [flags: [first-fixed undraggable]]
splitter [origin 0x0 space 0x0
below
text bold " GUI"
panel 400x400 (load trim gui) ON-CREATED [mif/output: face]
] options [flags: [first-fixed undraggable]]
] options [flags: [separator]]
] options [flags: [first-fixed undraggable]]
] options [min-child-size: 600x400] ; scrollable-panel
] options [flags: [first-fixed undraggable] first-min-size: 24]
]
main-window: win
;
] ; context
if system/script/header/type <> "module" [ ; were we started directly?
;if system/script/title = none [
;print "" ; open console for debug
;react compose [live-vid-ctx-sp/size: live-vid-ctx/win/size - (live-vid-ctx/win/size - live-vid-ctx-sp/size)]
;view/flags live-vid-ctx/win 'resize
view/flags/options livecode_VID.red-ctx/win 'resize
[
actors: object [
on-close: func [face event][either confirm "Exit now?" [unview]['continue]]
on-create: func [face][face/data: face/size] ; init value
on-focus: func [face event][face/data: face/size] ; store old size
;on-resize: func [face event][face/actors/on-resizing face event] ; forward
on-resize: func [face event /local siz][
siz: face/size - face/data ; compute size difference
face/data: face/size ; store new size
live-vid-ctx-spl/size: live-vid-ctx-spl/size + (siz * 1x1)
if not system/view/auto-sync? [show live-vid-ctx-spl]
]
]
]
]; if ourselves
livecode_VID.red-ctx/win/pane ; returned from script
] ; either ok?
Raw
Mini_console.red
Red [Needs: 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
Title: "Mini Console"
Author: @luce80
File: %Mini_console.red
Needs: 'View
Usage: {
Just write some code and test it.
}
Tabs: 4
version: 0.0.4
history: [
0.0.0 [25-02-2024 "Started"]
0.0.1 [28-02-2024 "Something happens"]
0.0.3 [24-02-2024 "Transformed into a module of Mini_edit_do"]
0.0.4 [07-04-2024 "Fixed 'form-error'"]
]
type: none ;'module ; TBD
import-gists: [ ; TBD
'action-requesters.red/action-requesters.red
'red-vid-styles.red/area-rt.red
'red-vid-styles.red/splitter.red
]
import-local: [ ; TBD
%gui/action-requesters.red
%gui/widgets/area-rt.red
%gui/widgets/splitter.red
]
]
probedo: func [code [block!] /local result][print [mold code mold/only result: reduce code] do :result]
; module
undirize: func [
"Returns a copy of the path turned into a file."
path [file! url! string!]
][
path: copy path
while [find "/\" path: back tail path] [remove path]
head path
]
read-gist: func [
"Returns a Gist from GitHub, or none"
id [issue!]
filename [string! any-word! file!]
/local gists
][
gists: load/as rejoin [https://api.github.com/gists/ id] 'json
attempt [gists/files/(to word! to string! filename)/content]
]
load-script-thru-gists: function [
"Read a @luce80 gist"
gist [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! gist
;?? gist
if (length? gist) > 2 [do make error! "Wrong path"]
if cache [
cached: cache/(undirize to file! gist/2)
if string? cached: attempt [read cached] [return cached]
]
issue: any [select [
red-vid-styles.red #433286c66d98997aff6e69fbd6323a35
action-requesters.red #89be16a8d0a3031b41cc49795e6e20b4
] gist/1
#433286c66d98997aff6e69fbd6323a35] ; red-vid-styles.red
read-gist issue gist/2
]
;
; import
system/script/header/type: none
caching: %.
if system/script/args <> "" [
do system/script/args
system/script/header/type: type
]
get-module: function [
"Do a @luce80 module"
path [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [return true] ; avoid reloading
file: load-script-thru-gists/cached path cache
either file [do file true][false]
]
view/no-wait w1: layout [text font-size 20 "Downloading widgets..."]
ok?: all [
get-module/cached 'action-requesters.red/action-requesters.red caching
;get-module/cached 'red-vid-styles.red/area-plus.red caching/widgets ;@@ obsolete ;)
get-module/cached 'red-vid-styles.red/area-rt.red caching/widgets
get-module/cached 'red-vid-styles.red/splitter.red caching/widgets
;get-module/cached 'red-vid-styles.red/scrollable-panel.red caching/widgets/scroller
get-module/cached 'red-vid-styles.red/spinner-panel.red caching/widgets
]
unview/only w1
;
either not ok? [view [below center text font-size 20 font-color red "Couldn't open or download widgets..." button "OK" [unview]]
ok? ; returned from script
][
; do the rest of the script
Mini_console.red-ctx: context [
; misc
use: func [words [block!] body [block!]][body: has words body body]
could_be: func [:path [set-path!] value][
if :value [set/any path :value]
]
;
; update, do-actor
update_draw: func [source] [
do-actor source none 'key-up
show source
]
do-actor: func [
"Internal Use Only"
face [object!] event [event! none!] type [word!]
/local result act name
][
if all [
object? face/actors
act: in face/actors name: any [select system/view/evt-names type type] ;@@ modified
act: get act
] [
if debug-info? face [print ["calling actor:" name]]
set/any 'result do-safe [act face event]
]
:result
]
; patches
doing: false
old-length: 0
old-quit: :quit
output-face: none
prin*: func [value][
output-face/insert-text form value 0 ; use method because it is cleaner and supports undos
do-actor output-face none 'change
show output-face
]
old-prin: :system/words/prin
prin: func [value] [
; check for interruption
_broken?!_
;either all [(100000 + old-length) > (length? output-face/text) doing] [ ; avoid fill mem
output-face/insert-text form reduce value 0 ; use method because it is cleaner and supports undos
;@@ avoid blocking the gui, must use a loop..., small numbers give less responsive GUI but should interfere less with the execution of the script (I hope)
loop 3 [do-events/no-wait]
;][
; if confirm/with "ERROR. Probable infinite loop. Clear Results?" ["Yes" "Cancel"] [clear output-face/text]
;throw
;]
exit ; force unsetting result
]
old-print: :system/words/print ; use these to output to console
print: func [value] [prin value prin newline]
probbed: none
old-probe: :system/words/probe ; func [value] [old-print mold :value :value]
probe: func [value] [probbed: get 'value print mold :value :value]
; re-make these to let them use the patched prin and print
help: func [
{Displays information about functions, values, objects, and datatypes.}
'word [any-type!]
][
print help-string :word
]
??: func [
"Prints a word and the value it refers to (molded)"
'value [word! path!]
][
prin mold :value
prin ": "
print either any [path? :value value? :value] [mold get/any :value] ["unset!"]
]
;
; error
err?: func [blk /local arg1 arg2 arg3 message err][;derived from 11-Feb-2007 Guest2
if not error? set/any 'err try blk [return get/any 'err]
form-error err
:err
]
form-error: function [
"Forms an error message from an error!"
err [error!]
][;derived from 11-Feb-2007 Guest2
arg1: any [attempt [:err/arg1] 'unset]
arg2: any [attempt [:err/arg2] 'unset]
arg3: any [attempt [:err/arg3] 'unset]
message: system/catalog/errors/(err/type)/(err/id)
unless string? message [
message: bind to-block message 'err
]
rejoin ["** " system/catalog/errors/(err/type)/type ": " form reduce message newline
"** Near: " either block? err/near [mold/only err/near][err/near] newline]
]
;
; test
_break?!_: no
_broken?!_: does [if _break?!_ [throw/name '_halted!!_ 'mini_console_catch]]
_break_it!!_: does [_break?!_: yes]
test: func [
text
/console
/local script result temp
][
_break?!_: no
console: true
;if all [not console mif/check-clear-res/data] [clear mif/output/text old-length: 0]
if all [console mif/check-clear-res/data] [mif/output/remove-text 1 0 old-length: 0]
temp: copy text
doing: true
if all [console mif/check-commands/data] [print [">>" temp]]
set/any 'result try/all [
catch/name
bind compose [(try/all [load text])] 'test ; 2nd most internal try/all is used to "catch" syntax errors during loading
'mini_console_catch
]
case [
unset? get/any 'result [exit]
error? get/any 'result [prin form-error :result]
'_halted!!_ = get/any 'result [prin* "** HALTED!" prin* newline] ;@@ I cannot use prin again because I would re-throw to the same catch (?)
true [;probe result]
old-length: old-length + length? mif/output/text
temp: copy/part mold :result 100000
if (length? temp) = 100000 [append temp "..."]
either console [
print ["==" temp]
][
if not equal? mold :probbed temp [ ; avoid reprinting last result
print temp
]
]
]
]
doing: false
_break?!_: no
]
;
; GUI
main-window: none
focus: func [face [object!]][face/selected: 1x1 + length? face/text set-focus face]
system/view/VID/styles/textmin: [template: [type: 'text size: 0x0]]
MIF: object [ ;; My Important Faces , idea taken from @dsunanda
check-commands:
button-do:
button-halt:
button-clear-res:
check-clear-res:
output:
source:
none
]
history: copy [{print "Hello World!"} ]
win: layout compose [
title (system/script/header/title)
;title "Mini Console"
;title (select select load system/options/script 'Red 'title)
mini-console-ctx-spl: splitter [; @@ I cannot overwrite on-create nor on-created :( therefore I am giving a "unique" name
origin 0x0
below
spinner-panel [
origin 0x0 space 4x4
check "Show commands" [set-focus mif/source] ON-CREATED [mif/check-commands: face]
pad 100x0
button "Do Clipboard" 90 [test/console read-clipboard]
button "Do Sc&ript" bold [test/console mif/source/text set-focus mif/source]
button "Halt" bold font-color red [_break_it!!_]
pad 73x0
button "Clear Results" [mif/output/remove-text 1 0 update_draw mif/source set-focus mif/source]
check "before every do" [set-focus mif/source] ON-CREATED [mif/check-clear-res: face]
]
splitter [origin 0x0 space 0x4
below
splitter [origin 0x0 space 0x2
below
textmin bold " Results ==" no-wrap ; @@ must use spaces to move text :(
area-rt 400x200 silver font-name system/view/fonts/fixed
options [flags: [read-only]]
ON-CREATED [
set-flag/clear face 'focusable
mif/output: output-face: face
]
] options [flags: [first-fixed undraggable] first-min-size: 15]
splitter [origin 0x0 space 0x2
below
textmin bold " Command >>"
field 400 {print "Hello World!"} font-name system/view/fonts/fixed focus
ON-CREATED [
face/selected: 0x-1 ;@@ should be 1x-1 ...
mif/source: face
]
ON-KEY [
case [
event/key = 'up [
history: back history
could_be face/text: copy pick history 1
focus face
]
event/key = 'down [
unless tail? next history [history: next history]
could_be face/text: copy pick history 1
focus face
]
]
]
[ ; action function
test/console face/text
use [code][
code: copy face/text
if (first history) <> code [history: back insert tail history code]
]
]
] options [flags: [second-fixed undraggable] ]
] options [flags: [second-fixed undraggable] second-min-size: 45]
] options [flags: [first-fixed undraggable] first-min-size: 24]
]
;
] ; context
;help mini-console-ctx-spl
if system/script/header/type <> "module" [ ; were we started directly?
;if system/script/title = none [
;old-print "" ; open console for debug
view/flags/options Mini_console.red-ctx/win 'resize [
actors: object [
on-key: func [face event] [;probedo [event/key]
switch event/key [
#"^O" [do-actor Mini_console.red-ctx/mif/button-open none 'click]
#"^S" [do-actor Mini_console.red-ctx/mif/button-save none 'click]
]
]
; on-close: func [face event][either confirm "Exit now?" [unview]['stop]]
on-create: func [face][face/data: face/size] ; init value
on-focus: func [face event][face/data: face/size] ; store old size
on-resize: func [face event][face/actors/on-resizing face event] ; forward
on-resizing: func [face event /local siz][
siz: face/size - face/data ; compute size difference
face/data: face/size ; store new size
mini-console-ctx-spl/size: mini-console-ctx-spl/size + (siz * 1x1)
if not system/view/auto-sync? [show mini-console-ctx-spl]
]
]
]
]; if ourselves
Mini_console.red-ctx/win/pane ; returned from script
] ; either ok?
Raw
Mini_edit.red
Red [Needs: 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
Title: "Mini edit"
Author: @luce80
File: %Mini_edit.red
Needs: 'View
Usage: {
Just write some code and test it.
}
Notes: {
Thanks to Gregg Irwing for showing me the way to halt an executing script.
}
Tabs: 4
version: 0.0.6
history: [
0.0.0 [17-01-2024 "Started"]
0.0.1 [30-01-2024 "Something happens"]
0.0.3 [24-02-2024 "Transformed into a module of Mini_edit_do"]
0.0.5 [25-03-2024 "Changed for new 'import'"]
0.0.6 [07-04-2024 "Fixed 'print' and 'form-error'"]
]
;type: 'module ; TBD , DO NOT SET, will be overwritten by import
import-gists: [ ; TBD
'action-requesters.red/action-requesters.red
'red-vid-styles.red/area-rt.red
'red-vid-styles.red/splitter.red
]
import-local: [ ; TBD
%gui/action-requesters.red
%gui/widgets/area-rt.red
%gui/widgets/splitter.red
]
]
probedo: func [code [block!] /local result][print [mold code mold/only result: reduce code] do :result]
; module
undirize: func [
"Returns a copy of the path turned into a file."
path [file! url! string!]
][
path: copy path
while [find "/\" path: back tail path] [remove path]
head path
]
read-gist: func [
"Returns a Gist from GitHub, or none"
id [issue!]
filename [string! any-word! file!]
/local gists
][
gists: load/as rejoin [https://api.github.com/gists/ id] 'json
attempt [gists/files/(to word! to string! filename)/content]
]
load-script-thru-gists: function [
"Read a @luce80 gist"
gist [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! gist
;?? gist
if (length? gist) > 2 [do make error! "Wrong path"]
if cache [
cached: cache/(undirize to file! gist/2)
if string? cached: attempt [read cached] [return cached]
]
issue: any [select [
red-vid-styles.red #433286c66d98997aff6e69fbd6323a35
action-requesters.red #89be16a8d0a3031b41cc49795e6e20b4
] gist/1
#433286c66d98997aff6e69fbd6323a35] ; red-vid-styles.red
read-gist issue gist/2
]
;
; import
caching: any [attempt [system/script/header/cache] %.]
if system/script/args <> "" [
system/script/header/type: none
do system/script/args
system/script/header/type: type
]
get-module: function [
"Do a @luce80 module"
path [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [return true] ; avoid reloading
file: load-script-thru-gists/cached path cache
either file [do file true][false]
]
view/no-wait w1: layout [text font-size 20 "Downloading widgets..."]
ok?: all [
get-module/cached 'action-requesters.red/action-requesters.red caching
;get-module/cached 'red-vid-styles.red/area-plus.red caching/widgets ;@@ obsolete ;)
get-module/cached 'red-vid-styles.red/area-rt.red caching/widgets
get-module/cached 'red-vid-styles.red/splitter.red caching/widgets
;get-module/cached 'red-vid-styles.red/scrollable-panel.red caching/widgets/scroller
get-module/cached 'red-vid-styles.red/spinner-panel.red caching/widgets
]
unview/only w1
;
either not ok? [view [below center text font-size 20 font-color red "Couldn't open or download widgets..." button "OK" [unview]]
ok? ; returned from script
][
; do the rest of the script
Mini_edit.red-ctx: context [
; file
saved?: yes
named?: false
job-name:
code:
none
change_title: func [/modified] [
clear any [find/tail main-window/text "- " main-window/text]
;either modified [append main-window/text "*" saved?: no][saved?: yes]
if any [modified not saved?] [append main-window/text "*" saved?: no]
append main-window/text to-string last split-path any [job-name %Untitled]
]
open_file: func [/local file-name job] [
until [
file-name: request-file/title "Load a Red source text file"
if none? file-name [return none]
exists? file-name
]
job-name: file-name
job: read file-name
code: copy job
named?: yes
mif/source/clear-text
mif/source/insert-text job 1
saved?: yes
change_title
job
]
save_file: func [job [string!] /as /local file-name filt ext] [
if all [empty? job not confirm "Save an empty file?"] [return false]
if not named? [as: true]
if as [
ext: %.red
file-name: request-file/title/save/filter "Save as text file" ["Red file (*.red)" "*.red" "All files (*.*)" "*.*"]
if none? file-name [return false]
if not equal? suffix? file-name ext [append file-name ext]
if exists? file-name [
if not confirm rejoin [{File "} last split-path file-name {" already exists, overwrite it?}] [
return false
]
]
job-name: file-name
named?: yes
]
flash append copy "Saving to: " to-local-file job-name
write job-name job
code: copy job
wait 1
unview
saved?: yes
change_title
true
]
undo: does [
mif/source/undo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
;apply 'change_title/:modified [strict-equal? code mif/source/text]
]
redo: does [
mif/source/redo
either strict-equal? code mif/source/text [saved?: yes change_title][change_title/modified]
]
; update, do-actor
update_draw: func [source] [
show source
do-actor source none 'key-up
]
do-actor: func [
"Internal Use Only"
face [object!] event [event! none!] type [word!]
/local result act name
][
if all [
object? face/actors
act: in face/actors name: any [select system/view/evt-names type type] ;@@ modified
act: get act
] [
if debug-info? face [print ["calling actor:" name]]
set/any 'result do-safe [act face event]
]
:result
]
; patches
doing: false
old-length: 0
old-quit: :quit
output-face: none
prin*: func [value][
output-face/insert-text form value 0 ; use method because it is cleaner and support undos
do-actor output-face none 'change
]
old-prin: :system/words/prin
prin: func [value] [
; check for interruption
_broken?!_
output-face/insert-text form value 0 ; use method because it is cleaner and supports undos
;@@ avoid blocking the gui, must use a loop..., small numbers give less responsive GUI but should interfere less with the execution of the script (I hope)
loop 3 [do-events/no-wait]
;][
; if confirm/with "ERROR. Probable infinite loop. Clear Results?" ["Yes" "Cancel"] [clear output-face/text]
;throw
;]
exit ; force unsetting result
]
old-print: :system/words/print ; use these to output to console
;print: func [value] [prin value prin newline]
print: func [value] [prin append form reduce :value newline]
probbed: none
old-probe: :system/words/probe ; func [value] [old-print mold :value :value]
probe: func [value] [probbed: get 'value print mold :value :value]
; re-make these to let them use the patched prin and print
help: func [
{Displays information about functions, values, objects, and datatypes.}
'word [any-type!]
][
print help-string :word
]
??: func [
"Prints a word and the value it refers to (molded)"
'value [word! path!]
][
prin mold :value
prin ": "
print either any [path? :value value? :value] [mold get/any :value] ["unset!"]
]
;
; error
err?: func [blk /local arg1 arg2 arg3 message err][;derived from 11-Feb-2007 Guest2
if not error? set/any 'err try blk [return get/any 'err]
form-error err
:err
]
form-error: function [
"Forms an error message from an error!"
err [error!]
][;derived from 11-Feb-2007 Guest2
arg1: any [attempt [:err/arg1] 'unset]
arg2: any [attempt [:err/arg2] 'unset]
arg3: any [attempt [:err/arg3] 'unset]
message: system/catalog/errors/(err/type)/(err/id)
unless string? message [
message: bind to-block message 'err
]
rejoin ["** " system/catalog/errors/(err/type)/type ": " form reduce message newline
"** Near: " either block? err/near [mold/only err/near][err/near] newline]
;throw
]
;
; test
; helper functions to let stop the script (thanks to @greggirwin)
_break?!_: no
_broken?!_: does [if _break?!_ [throw/name '_halted!!_ 'mini_edit_catch]]
_break_it!!_: does [_break?!_: yes]
test: func [
text
/console
/local script result catched
][
_break?!_: no
if all [not console mif/check-clear-res/data] [mif/output/clear-text old-length: 0]
;if all [not console mif/check-clear-res/data] [clear mif/output/text old-length: 0] ;@@ this combined with the following "bind" crushes Red (reactions problem?)
set/any 'result try/all [
catch/name
bind compose [(try/all [load text])] 'test ; 2nd most internal try/all is used to "catch" syntax errors during loading
'mini_edit_catch
]
case [
unset? get/any 'result [exit]
error? get/any 'result [prin form-error :result]
'_halted!!_ = get/any 'result [prin* "** HALTED!" prin* newline] ;@@ I cannot use prin again because I would re-throw to the same catch (?)
true [;probe result]
old-length: old-length + length? mif/output/text
temp: copy/part mold :result 100000
if (length? temp) = 100000 [append temp "..."]
either console [
print ["==" temp]
][
if not equal? mold :probbed temp [ ; avoid reprinting last result
print temp
]
]
]
]
_break?!_: no
]
;
;old-print "" ; open console for debug
; GUI
main-window: none
system/view/VID/styles/textmin: [template: [type: 'text size: 0x0]]
MIF: object [ ;; My Important Faces , idea taken from @dsunanda
splitter-main:
button-open:
button-save:
button-undo:
button-redo:
check-clear-res:
source:
output:
none
]
win: layout compose/deep [
ON-CREATED [
code: mif/source/get-text
]
title (append system/script/header/title " - Untitled")
;title "Mini edit"
;title (select select load system/options/script 'Red 'title)
splitter [
origin 0x0
below
spinner-panel [
origin 0x0 space 4x4
button "&Open..." [open_file] ON-CREATED [mif/button-open: face]
button "&Save" [save_file mif/source/text] ON-CREATED [mif/button-save: face]
pad -6x0
button "as..." 40 [save_file/as mif/source/text]
button "Undo" [undo] ON-CREATED [mif/button-undo: face]
button "Redo" [redo] ON-CREATED [mif/button-redo: face]
button "Do Sc&ript" bold [test mif/source/text]
button "Halt" bold font-color red [_break_it!!_]
button "Clear Test" [if confirm "Are you sure?" [mif/source/remove-text 1 0 update_draw mif/source change_title/modified]]
button "Clear Results" [mif/output/remove-text 1 0 update_draw mif/source]
check "before every do" ON-CREATED [mif/check-clear-res: face]
]
splitter [origin 0x0 ;space 0x4
below
splitter [origin 0x0 space 0x2
below
textmin bold " Test" no-wrap ; @@ must use spaces to move text :(
area-rt 400x200 focus {print "Hello World!"^/}
font-name system/view/fonts/fixed
ON-CREATED [mif/source: face]
ON-CHANGE [change_title/modified]
] options [flags: [first-fixed undraggable] first-min-size: 15]
splitter [origin 0x0 space 0x2
below
textmin bold " Results"
area-rt "" 400x200 silver font-name system/view/fonts/fixed
options [flags: [read-only]]
ON-CREATED [
set-flag/clear face 'focusable
mif/output: output-face: face
]
] options [flags: [first-fixed undraggable] first-min-size: 15]
] options [flags: [separator]]
] options [flags: [first-fixed undraggable] first-min-size: 24]
ON-CREATED [mif/splitter-main: face]
]
main-window: win ; used by change_title
;
] ; context
;help mini-edit-ctx-spl
if system/script/header/type <> "module" [ ; were we started directly?
;if system/script/title = none [
;wait 1 loop 10 [do-events/no-wait] ; flush key events used to launch Red.exe !!? to see when om-key-up is called
system/view/capturing?: true ; necessary to capture keys before area-rt :(
view/flags/options Mini_edit.red-ctx/win 'resize [
actors: object [
on-detect: func [face event /local keys act] [;
if all ['key-down = event/type char? event/key] [
keys: append event/flags event/key
do act: select/only [
[control #"O"] [Mini_edit.red-ctx/open_file]
[control #"S"] [Mini_edit.red-ctx/save_file Mini_edit.red-ctx/mif/source/text]
[control #"Z"] [Mini_edit.red-ctx/undo]
[control shift #"Z"] [Mini_edit.red-ctx/redo]
[control #"R"] [Mini_edit.red-ctx/test Mini_edit.red-ctx/mif/source/text]
] keys
return either act ['stop][none]
]
]
; on-close: func [face event][either confirm "Exit now?" [unview]['stop]]
on-create: func [face][face/data: face/size] ; init value
on-focus: func [face event][face/data: face/size] ; store old size
on-resize: func [face event][face/actors/on-resizing face event] ; forward
on-resizing: func [face event /local siz][
siz: face/size - face/data ; compute size difference
face/data: face/size ; store new size
Mini_edit.red-ctx/mif/splitter-main/size: Mini_edit.red-ctx/mif/splitter-main/size + (siz * 1x1)
;mini-edit-ctx-spl/size: mini-edit-ctx-spl/size + (siz * 1x1)
;if not system/view/auto-sync? [show mini-edit-ctx-spl]
]
]
]
]; if ourselves
Mini_edit.red-ctx/win/pane ; returned from script
] ; either ok?
Raw
mini_edit_do.red
Red [Needs: 'View]
system/script/header: make system/standard/header [ ;@@ workaround for #4992
system/script/title: ;@@ workaround for #4992 (to be used only in "main" script)
title: "Mini_edit_do"
file: %mini_edit_do.red
author: "Marco Antoniazzi"
Copyright: "(C) 2024 Marco Antoniazzi. All Rights reserved."
Licence: 'BSD
version: 1.0.2
Purpose: "Helps test short programs (substitutes console)"
Tabs: 4
history: [
0.0.0 [06-01-2024 "Started"]
0.0.1 [07-01-2024 "Something happens"]
0.0.2 [16-01-2024 "Suspended because area is too lame"]
0.0.3 [24-02-2024 "Restarted because area-rt is far superior and more then enough ;)"]
1.0.0 [23-03-2024 "Completed main aspects and added Mold_Red"]
1.0.1 [25-03-2024 "ADD: experimental `import` function"]
1.0.2 [27-04-2024 "FIX: Mold Red shortcut keys handling"]
]
]
probedo: func [:code [block!] /local result][print [mold code mold/only result: reduce code] do :result]
mini_edit_do-ctx: context [
exit_script: does [either empty? gui-console-ctx/terminal/lines [quit][unview/all halt]]
if system/build/date < 15-03-2024 [alert "A more recent version of Red is required !" exit_script] ; to use recent fixes
; module
undirize: func [
"Returns a copy of the path turned into a file."
path [file! url! string!]
][
path: copy path
while [find "/\" path: back tail path] [remove path]
head path
]
read-gist: func [
"Returns a Gist from GitHub, or none"
id [issue!]
filename [string! any-word! file!]
/local gists
][
gists: load/as rejoin [https://api.github.com/gists/ id] 'json
;?? gists
set/any 'gists try [gists/files/(to word! to string! filename)/content]
either error? :gists [print ["Can't read gist" filename] filename][gists]
]
load-module-thru-gists: function [
"Read a @luce80 gist"
gist [path! lit-path!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! gist
if (length? gist) > 2 [do make error! "Wrong path"]
if cache [
cached: cache/(undirize to file! gist/2)
if string? cached: attempt [read cached] [return cached]
]
issue: any [select [
red-vid-styles.red #433286c66d98997aff6e69fbd6323a35
action-requesters.red #89be16a8d0a3031b41cc49795e6e20b4
mold-red.red #bfa8b54ca8c7e726723072786cad56fa
mini_red_tools.red #1b1119fa7dc856cc36a34e1b7f8a2a8e
] gist/1
#433286c66d98997aff6e69fbd6323a35] ; red-vid-styles.red
read-gist issue gist/2
]
;
; import
; "caching" is used to give a local dir to avoid downloading widgets
caching: %gui
do-module: function [
"Do a @luce80 module"
path [path! lit-path!]
args [string!]
/cached
cache [file! logic! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [ctx: get ctx return ctx/win/pane] ; avoid reloading ;FIXME
file: load-module-thru-gists/cached path cache
either file [do/args file args][false]
]
import: func [
"Do one or more scripts as a module"
module [string! file! url! block!] "The module(s) to load and execute"
/cache dir [file! none!]
/local header sheader module-header result
][
either block? module [
forall module [import/:cache first module dir] ; use recursion to check datatype of every block's element
][
module: load module
if module/1 <> 'Red [cause-error 'syntax 'no-header module]
header: system/script/header ; store our header
sheader: system/standard/header ; store standard header
module-header: make object! module/2
system/standard/header: make module-header [type: "module" cache: dir]
set/any 'result do module
system/script/header: header ; restore our header
system/standard/header: sheader; restore standard header
:result
]
]
do-module*: function [
"Do a @luce80 module"
path [path! lit-path!]
/cache
dir [file! none!]
][
gist: to block! to path! path
ctx: to word! append (to string! gist/2) "-ctx"
if value? ctx [ctx: get ctx return ctx/win/pane] ; avoid reloading ;FIXME
text: load-module-thru-gists/cached path dir
either text [import/:cache text dir][false]
]
view/no-wait wm: layout [text font-size 20 "Downloading modules..."]
ok?: all [
none? do-module/cached 'action-requesters.red/action-requesters.red "" caching
p1: do-module*/cache 'mini_red_tools.red/Mini_edit.red caching
;p1: do-module/cached 'mini_red_tools.red/Mini_edit.red "type: {module} caching: %gui" caching
p2: do-module/cached 'mini_red_tools.red/Mini_console.red "type: {module} caching: %gui" caching
p3: do-module/cached 'mini_red_tools.red/livecode_VID.red "type: {module} caching: %gui" caching
p4: do-module/cached 'mini_red_tools.red/livecode_draw.red "type: {module} caching: %gui" caching
p5: do-module/cached 'mold-red.red/mold-red.red "type: {module} caching: %debug" %debug
]
unview/only wm
if not ok? [view [below center text font-size 20 font-color red "Couldn't open or download tools..." button "OK" [unview]] exit_script]
;
; GUI
change_title: func [title [string!]][
append clear any [find/tail win/text "- " tail win/text] title
]
ask_close: does [
either any [
not Mini_edit.red-ctx/saved?
not livecode_VID.red-ctx/saved?
not livecode_draw.red-ctx/saved?
] [
if request/confirm/title/type "Thera are unsaved changes, exit now?" "Please confirm" 'alert [exit_script]
][
if confirm "Exit now?" [exit_script]
]
'continue ;@@ UNDOCUMENTED !!
]
max-size: 0x0
foreach face p1 [max-size: max max-size face/size]
foreach face p2 [max-size: max max-size face/size]
foreach face p3 [max-size: max max-size face/size]
foreach face p4 [max-size: max max-size face/size]
;max-size: max-size ; FIXME + system/view/metrics/paddings
win: layout compose [
title (append system/script/title " - Untitled")
tb: tab-panel (to-pair max-size + 22x42) [
"Mini Editor" [
; to be filled
]
"Mini Console" [
; to be filled
]
"Live VID" [
; to be filled
]
"Live Draw" [
; to be filled
]
"Mold Red" [
; to be filled
]
]
on-change [
switch event/picked [
1 [
main-ctx: Mini_edit.red-ctx
main-ctx/change_title
set-focus main-ctx/mif/source
]
2 [
change_title "Mini Console"
main-ctx: Mini_console.red-ctx
main-ctx/mif/source/selected: as-pair 1 length? main-ctx/mif/source/text
set-focus main-ctx/mif/source
]
3 [
main-ctx: livecode_VID.red-ctx
main-ctx/change_title
set-focus main-ctx/mif/source
]
4 [
main-ctx: livecode_draw.red-ctx
main-ctx/change_title
set-focus main-ctx/mif/source
]
5 [
main-ctx: none
change_title "Mold Red"
focus p5/8
]
]
]
]
win/pane/1/pane/1/pane: p1 ; Mini Edit
win/pane/1/pane/2/pane: p2 ; Mini Console
win/pane/1/pane/3/pane: p3 ; Live VID
win/pane/1/pane/4/pane: p4 ; Live Draw
win/pane/1/pane/5/pane: p5 ; Mold Red
p1/1/size:
p2/1/size:
p3/1/size:
p4/1/size: max-size
p5/8/size/x: to-integer max-size/x - p5/8/offset/x + 10 ; field
p5/9/offset/x: max-size/x - p5/9/size/x + 10 ; "?"
p5/10/size: max-size - p5/10/offset + 10x10 ; area
main-ctx: Mini_edit.red-ctx
; this is used to change the window's title
Mini_edit.red-ctx/main-window:
livecode_VID.red-ctx/main-window:
livecode_draw.red-ctx/main-window:
win
faces: reduce [tb p1/1 p2/1 p3/1 p4/1 p5/10]
system/view/capturing?: true ;@@ necessary to capture keys before area-rt :(
view/flags/options win 'resize [
actors: object [
on-detect: func [face event /local keys act] [;
if all ['key-down = event/type char? event/key][
keys: append event/flags event/key
attempt [ do act: select/only [
[control #"O"] [main-ctx/open_file]
[control #"S"] [main-ctx/save_file main-ctx/mif/source/text]
[control #"Z"] [main-ctx/undo]
[control shift #"Z"] [main-ctx/redo]
[control #"R"] [main-ctx/test main-ctx/mif/source/text]
[#"^(esc)"] [ask_close]
] keys]
return either act ['stop][none]
]
]
on-close: func [face event][ask_close]
on-create: func [face][face/data: face/size] ; init value
on-focus: func [face event][face/data: face/size] ; store old size
on-resize: func [face event /local siz fac][
siz: face/size - face/data ; compute size difference
face/data: face/size ; store new size
foreach fac faces [fac/size: fac/size + (siz * 1x1)]
p5/8/size: p5/8/size + (siz * 1x0)
p5/9/offset: p5/9/offset + (siz * 1x0)
]
]
]
;
] ; context
() ; return unset
Raw
Mini_Red_tools.red
Red [Needs: 'View]
;
;%mini_edit_do.red
;%Mini_edit.red
;%Mini_console.red
;%livecode_VID.red
;%livecode_draw.red
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment