Created
December 7, 2017 05:29
-
-
Save mikeyaunish/851a2d4822fa98f3f6a0f3437a76f2ce to your computer and use it in GitHub Desktop.
Based on Dockimbel and Didier VID livecode. Added saving and loading of files and window configuration. Make VID updates controllable.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Red [ | |
Title: "Simple GUI livecoding demo" | |
Author: "Nenad Rakocevic / Didier Cadieu / Mike Yaunish" | |
File: %livecode-enhanced.red | |
Version: 1.3.0 | |
Needs: 'View | |
Usage: { | |
Type VID code in the bottom left area, you will see the resulting GUI components | |
rendered live on the right side and fully functional (events/actors/reactors working live). | |
The top left area lets you define Red's values to be used in your VID code, even functions or anything. | |
} | |
History: [ | |
1.0.0 "01-09-2016" "First version (Nenad)." | |
1.1.0 "09-09-2016" "Addition of red code predefinitions area and window resizing (Didier)." | |
1.2.0 "21-09-2016" "Addition of vertical and horizontal spliters (Didier)." | |
1.2.1 "06-10-2016" "Correction of vertical spliter resize (Didier)." | |
1.3.0 "06-12-2017" {Added: Live update check, manual update buttons, Save/Open/New of script as | |
well as Update check and panel sizes. | |
Autosave of file when it interprets correctly. Control+Tilde or middle mouse | |
to see details of the object that you are over (Mike)} | |
] | |
Tabs: 4 | |
] | |
copy-file: func [ | |
Source [file! url!] | |
Destination [file!] | |
][ | |
write/binary Destination read/binary Source | |
] | |
string-to-block: function [s [string!]] [ | |
lines: split s "^/" | |
res: copy "" | |
if ((trim lines/1) = "") [ | |
lines: skip lines 1 | |
] | |
foreach l lines [ | |
append res rejoin [ " " l "^/" ] | |
] | |
return rejoin [ "[^/" res "]" ] | |
] | |
un-block-string: function [ b [string!] ] [ | |
trim/head (trim/tail b) | |
lines: split b "^/" | |
if ((first lines) = "[") [ remove lines ] | |
if ((last lines) = "]") [ remove back tail lines ] | |
res: copy "" | |
foreach l lines [ | |
append res rejoin [ ( skip l 4 ) "^/" ] | |
] | |
return res | |
] | |
find-object-name: function [o] [ | |
all-words: words-of system/words | |
ndx: 0 | |
foreach wrd all-words [ | |
if all [ | |
(value? in system/words wrd) | |
(any-object? get in system/words wrd) | |
(o = (get in system/words wrd)) | |
((copy/part (to-string wrd) 2) <> "--") | |
][ | |
return to-string wrd | |
] | |
] | |
return "-no-name-" | |
] | |
to-my-logic: function [v] [ | |
return switch/default v [ | |
true [ true ] | |
false [ false ] | |
][ to-logic v ] | |
] | |
livecode-ctx: context [ | |
; Isolate the code to not missbehave on some reuse of its words by the user code | |
root-path: copy what-dir | |
livecode-re: make reactor! [ | |
current-file: repend (copy root-path) %default-livecode.red | |
] | |
setup-size: 800x200 | |
vid-size: 800x400 | |
output-size: 800x600 | |
live-update?: true | |
last-livecode-file: repend (copy root-path) %last-livecode-file-used.data | |
if (exists? last-livecode-file) [ | |
llf: load last-livecode-file | |
livecode-re/current-file: llf/filename | |
setup-size: llf/setup-size | |
vid-size: llf/vid-size | |
output-size: llf/output-size | |
live-update?: to-my-logic llf/live-update? | |
] | |
extract-setup-code: function [ the-code ] [ | |
un-block-string any [ (second split ( first split the-code "view [") "do setup:") "" ] | |
] | |
extract-vid-code: function [ the-code ] [ | |
un-block-string any [ (second split the-code "^/view " ) "" ] | |
] | |
load-livecode: function [filename [ file! ] ] | |
[ | |
if (exists? filename)[ | |
setup-code/text: extract-setup-code (filedata: read filename) | |
vid-code/text: extract-vid-code filedata | |
livecode-re/current-file: filename | |
] | |
] | |
save-livecode: function [ filename [ file!] ] | |
[ | |
tf: copy "" | |
write filename append tf reduce [ | |
{Red [ Title: "} to-string second split-path filename {"]^/^/do setup:} | |
string-to-block any [ setup-code/text "" ] | |
"^/^/" | |
"view " | |
string-to-block any [ vid-code/text "" ] | |
] | |
save repend (copy root-path) %last-livecode-file-used.data reduce [ | |
'filename filename | |
'setup-size setup-code/size | |
'vid-size vid-code/size | |
'output-size output/size | |
'live-update? live-update? | |
] | |
] | |
run-interpreter: does [ | |
either error? err: try/all [ | |
if setup-code/text [ | |
do load setup-code/text | |
] | |
true ; makes try happy | |
][ | |
print "--- SETUP CODE ERROR / VID CODE IGNORED ------" | |
print err | |
print "----------------------------------------------" | |
active-filename/color: yellow | |
setup-code/color: yellow | |
][ ;-- setup code ran clean | |
either error? err: try/all [ | |
if vid-code/text [ | |
output/pane: layout/only load vid-code/text | |
] | |
true ;-- makes try happy | |
][ | |
print "--- VID CODE ERROR ---------------------------" | |
print err | |
print "---------------------------------------------- " | |
active-filename/color: yellow | |
vid-code/color: yellow | |
][ | |
setup-code/color: white | |
vid-code/color: white | |
save-livecode livecode-re/current-file | |
active-filename/color: white | |
] | |
] | |
] | |
left-control-down: false | |
show-face-info: function [ f ] [ | |
g: copy f | |
g/parent: "...." | |
obj-name: find-object-name f | |
print [" OBJECT NAME " to-string obj-name ] | |
? g | |
] | |
livecode-event-handler: func [ | |
face [object!] | |
event [event!] | |
][ | |
if (event/type = 'over)[ | |
--over-face: face | |
] | |
if any [ (event/type = 'mid-up) ] [ | |
if (--over-face <> face)[ | |
--over-face: false | |
] | |
] | |
if any [ | |
(event/type = 'mid-up) | |
all [(event/key = to-char 192) (event/type = 'key-down) left-control-down ] | |
][ | |
if --over-face [ | |
show-face-info --over-face | |
] | |
] | |
if all [ (event/key = 'left-control) (event/type = 'key-down )][ | |
left-control-down: true | |
] | |
if all [ (event/key = 'left-control) (event/type = 'key-up )][ | |
left-control-down: false | |
] | |
if all [ | |
(event/type = 'key-up) | |
any [ (event/key = 'right-control) (event/key = 'F5) ] | |
][ | |
run-interpreter | |
] | |
if event/type = 'moving [ ; A little hacky - fires off the first interpret after the program has loaded. | |
if not (value? 'first-run?) [ | |
first-run?: false | |
run-interpreter | |
] | |
] | |
if event/type = 'close [ | |
remove-event-func :livecode-event-handler | |
] | |
; This handle the resize of window content when it is resized | |
if event/type = 'resize [ | |
sz: mainwin/size - orig | |
pan/size/y: sz/y - pan/offset/y | |
vid-code/size/y: pan/size/y - vid-code/offset/y - orig/y | |
output/size: sz - output/offset | |
splitv/size/y: sz/y - splitv/offset/y | |
'done | |
] | |
return none | |
] | |
insert-event-func :livecode-event-handler | |
; There is a spliter style that does what a splitter must do. Here is the functions it needs. | |
; Initialize the spliter data in regards to its initial content. | |
on-spliter-init: func [face [object!] /local data v sz? op axis] [ | |
; init global value | |
face/extra/fixedaxis: select [x y x] face/extra/axis: axis: either face/size/x < face/size/y ['x] ['y] | |
if not block? data: face/data [exit] | |
; Here is updated the face/data block by computing if the value of a move must be added or subtract | |
; to the facet regarding the face position, then store the operator next to the value. | |
forall data [ | |
v: copy data/1 | |
; search the face! object in the path | |
while [all [not empty? v not face? get v]] [all [sz?: take/last v none? find [size offset] sz? sz?: none]] | |
all [ | |
not empty? v | |
v: get v | |
; use 'add or 'substract depends on where it is in regards of the spliter and the property to change | |
op: pick [+ -] (v/offset/:axis > face/offset/:axis) xor (sz? = 'size) | |
insert data: next data op | |
] | |
] | |
] | |
; This func does what is needed when a splitter is moved. | |
; The splitter/data block! must contain pairs of "facet operator" values, where : | |
; - "facet" is a face path ending by /size or /offset that must be changed when the splitter move like a-face/size or a-face/offset, | |
; - "operator" is one of '+ or '-, and determines if the move amount is added or subtract to the "facet" value. | |
on-spliter-move: func [face [object!] /local amount fa] [ | |
fa: face/extra/fixedaxis | |
face/offset/:fa: face/extra/offset/:fa ; must not move on the fixed axis | |
amount: face/offset - face/extra/offset ; amount of the move since the last move | |
face/extra/offset: face/offset ; store the new offset | |
if any [amount = 0x0 not block? face/data] [exit] | |
foreach [prop op] face/data [ | |
do reduce [load rejoin [form prop ":"] prop op amount] ; update the value with the new amount. I miss 'to-set-word here | |
] | |
] | |
orig: 4x4 | |
view/flags/options/no-wait mainwin: layout compose [ | |
title "Red Livecoding" | |
backdrop gray | |
origin orig | |
space 0x0 | |
style area: area wrap font-name "Fixedsys" | |
style split: base 30x6 loose extra ['offset none 'auto-sync? none 'axis none 'fixedaxis none] | |
on-drag-start [face/extra/offset: face/offset face/extra/auto-sync?: system/view/auto-sync? system/view/auto-sync?: no] ; Need to disable realtime mode as the position is changed by the drag an the code | |
on-drag [on-spliter-move face show face/parent] | |
on-drop [system/view/auto-sync?: face/extra/auto-sync?] ; Don't forget to reset realtime mode to its previous value | |
on-over [face/color: either event/away? [gray][blue]] | |
on-create [on-spliter-init face] | |
pan: panel [ | |
below | |
origin orig | |
space 4x2 | |
across | |
update-check: check "Live Update" font-size 12 data live-update? [ | |
live-update?: update-check/data | |
save-livecode livecode-re/current-file | |
] | |
button "F5 or Right Ctrl = UPDATE" [ run-interpreter ] | |
text 85x24 font-size 12 right "Current File:" | |
active-filename: text font-size 12 180x24 center white react [ | |
active-filename/text: to-string second split-path livecode-re/current-file | |
] | |
button 40x24 "Save" [ | |
if (rf: request-file/title/file "Save as" root-path) [ | |
copy-file livecode-re/current-file rf | |
livecode-re/current-file: copy rf | |
] | |
] | |
button 40x24 "Open" [ | |
if (rf: request-file/title/file "Open" root-path) [ | |
load-livecode rf | |
run-interpreter | |
] | |
] | |
button 40x24 "New" [ | |
if (rf: request-file/title/file "Specify a NEW file name" root-path) [ | |
setup-code/text: "" | |
vid-code/text: "" | |
livecode-re/current-file: rf | |
run-interpreter | |
] | |
] | |
space 0x4 | |
return | |
below | |
text "Setup Code (before layout) :" 200x15 | |
setup-code: area no-wrap setup-size on-key-up [ if live-update? [ run-interpreter ] ] | |
pad 0x4 | |
; horizontal splitter | |
splith: split 800x6 data [setup-code/size vidtit/offset vid-code/offset vid-code/size] | |
vidtit: text "Layout code in VID dialect :" 150x15 | |
vid-code: area vid-size no-wrap font-name "Fixedsys" on-key-up [ if live-update? [ run-interpreter ] ] | |
] | |
do [ | |
load-livecode livecode-re/current-file | |
] | |
; vertical spliter | |
splitv: split 6x100 data [pan/size splith/size setup-code/size vid-code/size output/size output/offset] | |
output: panel output-size | |
] 'resize [ offset: 2x32 ] | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment