Example Red Scripts

My Red Script Runner
;;;; This will list all the Red scripts in the folder and allow you to choose and run them.
;;;;  A compiled version is on my Apps page.
;;;;  Tested on Win 10.

Red [needs: 'view author: Alan Brack date: 08/11/2017] folder: read %. count: 0 ;;;;;;;;;;;; create a script list in folder ;;;;;;;;;;;;;;;;;;;;; write %sList.dat "" foreach file folder [ if find file ".red" [ i: copy form file count: count + 1 ;;;;probe i write/append/lines %sList.dat i ] ] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; load script list into text-list ;;;;;;;;;;;; sData: load %sList.dat ;;;; make it text-list friendly ;;;; form-all: func [blok][forall blok [blok/1: form blok/1] blok] form-all sData list-chosen-text: func [ face "xxxx"] [t/text: pick face/data face/selected ] list-chosen-word: func [face "xxxx"] [to word! list-chosen-text face] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; start main view with buttons and text-list ;;;;;;;;;;; view/flags [backdrop mint title "Red script runner (ver. 1)"
             t: text italic "Choose from the list ->" 150x30 text-list linen data sData [attempt [list-chosen-word face ] ] below ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Run Red script ;;;;;;;;;;;;;;;;; at 10x50 button "Run Script" 100x30 [if t/text <> "Choose from the list ->" [ runner: to-file t/text do runner ] ] ;; <-- end button block and end if block ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ]['modal 'no-min] ;; <-- end of main view and flags





My File and Folder Hider
;;;; This will hide the folder called 'FolderVault'
;;;; Even if you set Windows to show hidden files. It will stay hidden.
;;;; Simply copy any files and folders you want hidden into 'FolderVault'

;;;; Once you've created a folder called 'FolderVault' your all set.
;;;; Compile the script, then you can hide 'FolderVault' and move your 
;;;; compiled  exe to somewhere else.
;;;; Or check out my Apps page for a password protected version.
;;;; Tested on Win 10.

Red [needs: 'view  author: Alan Brack   date:  16/10/2017 ]

view/flags [ title "File/Folder Vault" 
t: h5 italic font-color purple "Hide 'FolderVault' and its contents ...." 300x30 return
               
button "Hide Folder"  [either exists?  %FolderVault [
     call "start/min  attrib FolderVault +s +h"  t/text: "'FolderVault' Hidden"
     write %rfresh.txt "cause folder to refresh"  wait .5   delete %rfresh.txt   ] [
      view/flags [ title "Warning !" h5 "A folder called 'FolderVault' MUST exist !"]['modal 'no-min ] ] ]

button "Un-Hide Folder"  [either exists?  %FolderVault [  
     call "start/min attrib  FolderVault -s -h"  t/text: "'FolderVault' Un-Hidden"] [
     view/flags [ title "Warning !" h5 "A folder called 'FolderVault' MUST exist !"]['modal 'no-min ] ] ]
     ] ['modal 'no-min]





My SendKeys App
;;;; Send one or more keystrokes to the active window as if they were typed at the keyboard.
;;;; This one's a bit controversial - SendKeys is supposed to be unreliable,That is Not So ,  it's all about ;;;; timing (i.e. WScript.Sleep 1000) get the wait times right for your device and there's no problem. 
;;;; This script writes a vbs file to your folder, executes it, and then deletes it. Clean and efficient.
;;;  I know it works on Win 8, Win 8.1 and Win 10.   Possible Win 7 ? 

Red [needs: 'view  Author: Alan B]
vbsScript: {                                               
         set WshShell = WScript.CreateObject("WScript.Shell")
         WshShell.Run "C:\Windows\system32\calc.exe"
         WScript.Sleep 500
         WshShell.AppActivate "Calculator"
         WScript.Sleep 2000
         WshShell.SendKeys "4{+}3"
         WScript.Sleep 500
         WshShell.SendKeys "="
         WScript.Sleep 1000
         WshShell.SendKeys "2*3"
         WScript.Sleep 500
         WshShell.SendKeys "="
         WScript.Sleep 1000
}   
   
view/flags  [title "Alans SendKeys ...." size 150x60 backdrop cyan
button "Send Keystrokes"  [write %sendKeys01.vbs vbsScript  wait 1
            call "start sendKeys01.vbs"  wait 1  
            delete  %sendKeys01.vbs] 
]['modal 'popup]





My livecode extention
;;;; An experiment based on Nenads Livecode script,  I did this just for fun.  
;;;; Was just messing about with it ....
;;;; It allows you to Save and Load the Livecode code (data). 
;;;; You can run the Livecode from within the editor as a full Gui script. Use the 'GoRed' button.
;;;; It can also save the Livecode with the Red header and View block added  ...........  
;;;; so it is ready for compilation in the traditional Red way. Use the 'RedSave' button. 
;;;; The main thing is to know what you're saving your work as,  a 'livecode' script or a full 'Red script'.
;;;; Anyway, just try it, as I said, just a bit of fun .....

;;;; An experiment based on Nenads Livecoding script ;;;;
Red [needs: 'view ]        ;; <-- Begin main view window ;;
view/flags [ title "Red Livecoding - Extended"   

    ;;;; Start the output panel ;;;;
    output: panel 400x500  
    below 
    h5 bold italic font-color red "Red [needs: 'view ]" h5 bold italic font-color red "View [" 

    across
    ;;;; start the area ;;;;
    source: area black font-color white 500x500  focus wrap font-name "Fixedsys" 
;;;; Put some livecode in area ;;;;
{                                               
below  
h2 font-color blue "Hello"  
field  
area  
radio

h5 "**** Tap spacebar to get started !! ****"

}          ;;;;<--  stop putting livecode in area ;;;;

          ;;;; alter on-key-up to on-change  to handle pasting script
          on-change [attempt [output/pane: layout/only load source/text] ]  
          below
          ;;;; Buttons ;;;;
          button font-color brown "Save" [if sf: request-file/save  [unless suffix? sf [append sf %.liv]  write sf source/text  tx/text: "Saved." ] ]
          button font-color brown "Load" [if Lf: request-file [source/text: read Lf  tx/text: "Loaded." ] attempt [output/pane: layout/only load source/text ] ]
          button font-color red "RedSave" [if sf: request-file/save  [unless suffix? sf [append sf %.red]  write sf 
          rejoin [{Red [ ] 
View [ } source/text {]}  ] source/text  tx/text: "Saved." ] ]
          button font-color red "GoRed" [go: rejoin [{Red [ ]  View/flags [ } source/text {] 'modal [actors: object [on-close: func [face event][unview]]]}  ]  
                   tx/text: ""  do go attempt [output/pane: layout/only load source/text] ] 
          button font-color brown "Clear" [source/text: clear  output/pane: clear  tx/text: ""] 

          ;;;; Help section ;;;;
          button font-color brown "Help" [tx/text: "" view/flags [title "Help window" below
text "Remember, this is 'livecode' so if you use 'save and load' be sure to only load 'Livecode' scripts - Not scripts saved using 'RedSave'."
h5 font-color brown "'Save'  .... Saves your code (adds a .liv suffix if none is used)"
h5 font-color brown "'RedSave' .... Saves code with Red header and View block (adds a .red suffix if none is used)"
h5 font-color brown"'GoRed'  .... Runs code with Red header and View block - Interprets as a Red script  "
h5 font-color brown "'Load' .... Loads your code - (Be sure to only load Livecode code - with .liv suffix)"
h5 font-color brown "'Clear' .... Clears the editor and output panel"
h5 font-color brown "'Help' .... This help window"
] 'modal       ;; <-- ;;;; End of Help section ;;

]                     ;; <-- ;;;; End of the area  ;;
                  tx: text ""
at 470x580 h5 bold italic font-color  red " ]"

                   ] 'no-min         ;; <--  ;;;; End of main view ;;





My Quiz App
;;;; This is a much simplified example of my Quiz App ....
;;;; Please make sure the 'questions.dat' is in the program folder .....

Red [title: "Quiz" 
        Author:  "Alan Brack"  
        needs: 'view] 

myScore: 0 count: 0 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;routine to seed the random generator;;;;;;;
sd: routine [ return: [integer!] /local address [pointer! [byte!]]][ address: allocate 4 free address
    return as integer! address]random/seed sd
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;no title bars and stay on top ;;;;;;;;;;;
flags: clear []
append flags 'modal
append flags 'no-title
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; correct and incorrect views ;;;;;;;;;;
dd: layout [ size 300x300 below text "Correct Answer !!!!" bold button "Correct" [unview]]
ee: layout [ size 300x300 below text "Wrong Answer !!!!" bold button "Wrong" [unview]]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
questions: load/all %questions.dat   ;; load the questions.dat

;;;;;;; start first foreach loop ;;;;;;
foreach [quest] random questions [
qq: copy quest
;;;;;;; start foreach loop to read data block  ;;;;;
foreach [qst ans ans2 ans3 ans4 oks] qq [ count: count + 1  

;;;;;;;; open main view ;;;;;;;;
   view/flags [ size 800x600 title "My Quiz"
    below
    text " " 
    text font-size 16 qst     ;;;; display the question
  text " "
;; display the answer buttons and keep track of score ;;
button 600x80 ans [either oks = "a" [view/flags dd flags] [view/flags ee flags] unview]
button 600x80 ans2 [either oks = "b" [view/flags dd flags][view/flags ee flags]  unview]
button 600x80 ans3 [either oks = "c" [view/flags dd flags][view/flags ee flags]  unview]
button 600x80 ans4 [either oks = "d" [view/flags dd flags] [view/flags ee flags]  unview]
button 600x80 font-color red "Quit the quiz ?" [quit]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
] flags  ;;;;;; end of the main view ;;;;;;  
]   ;;;; end of the foreach loop  ;;;;;
]  ;;;; end of first foreach loop ;;;;

;; NOTE: 
;; I have used a routine to seed the random generator, so script will need to be compiled.
;; You could comment out the 'sd' routine, then the script will interpret.
;; Ensure this 'questions.dat' is in your working folder.






My Watch App
;;;;   This is the full script for my  Watch App ....
;;;;  The only difference here is the need to load the 'r6.png' image from your folder ....
;;;;   Ensure the image is in your Red script folder .... get it and this script here: watchScript
;;;;   you need to use the 'last automated build' for this one ....

Red [title: "The Watch" 
        Author:  "Alan B"  
        needs: 'view] 

h: 30    ;;<-- variable used to help control the hour hand

;;;;; stay on top with no maximise and no minimise ;;;;
 flags: clear []
 append flags 'modal
 append flags 'no-max
 append flags 'no-min 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; open main view ;;;;;;;;
    view/flags [title "The Red 'SeaMariner'"
    backdrop grey
    image %r6.png        ;;;; ensure the graphic is in your script folder ....

  ;;;; draw hour, minute and second hands ;;;;
       at 30x80 base 200x200 rate 1 now transparent draw [
        scale 2 2
        line-cap round     ;;;; make the watch hands round at the ends
        hour: rotate 0 50x50 [line-width 5 pen #FFFFFF line 50x50 50x30 line-width 1 pen #202020 line 50x50 50x30]
        min:  rotate 0 50x50 [line-width 5 pen #FFFFFF line 50x50 50x20 circle 50x50 1 line-width 1 pen #202020 line 50x50 50x20]
        sec:  rotate 0 50x50 [line-width 1 pen #FF0000 line 50x50 50x18 circle 50x25 3]
    ] on-time [
        time: now/time
        either time/minute > 30 [h: 31][h: 30]      ;;<-- control the hour hand 
        hour/2: h * time/hour                                  
        min/2:  6  * time/minute      
        sec/2:  6  * time/second
    ]    
    ]flags      ;;;;;; end of the main view ;;;;;;  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Note ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Here's a way to make the hour and minute hands move perfectly smoothly ;;;;
;;;;  just use these four lines in place of the equivalent five in my above example ;;;;
;;;; Many thanks to:  Rudolf Meijer   for sending me this excellent improvement ;;;;
time: now/time
hour/2: (30.0 * modulo time/hour 12) + (time/minute * 0.5)
min/2:  (6.0  * time/minute) + (time/second * 0.1)    
sec/2:  6.0  * time/second
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;