From d1789269cbebc325fd81d6c6208bfe545a7a7b39 Mon Sep 17 00:00:00 2001
From: Bernd Paysan <bernd.paysan@gmx.de>
Date: Fri, 22 Jun 2018 00:45:26 +0200
Subject: [PATCH] scroll wheel for viewports change rec-shell so that shell
 commands have to be on the start of the line

---
 minos2/actors.fs | 28 +++++++++++++++++++++++++---
 script.fs        |  8 +++++---
 2 files changed, 30 insertions(+), 6 deletions(-)

diff --git a/minos2/actors.fs b/minos2/actors.fs
index 0805467da..2ab2a6385 100644
--- a/minos2/actors.fs
+++ b/minos2/actors.fs
@@ -251,12 +251,20 @@ screen-pwh max s>f FValue drag-rate \ 1 screen/s²
 : motion-time ( -- time )
     motion-dxy vmotion-dt drag-rate f* f/ ;
 
+: vp-deltaxy ( time -- rx ry )
+    fdup  vmotion-dx f* vpstart-x fswap f-
+    fswap vmotion-dy f* vpstart-y f+ ;
+
 : vp-motion ( 0..1 addr -- )
     >o fdup f**2 f2/ f-
     motion-dxy vmotion-dt f**2 drag-rate f* f/ f*
-    fdup  vmotion-dx f* vpstart-x fswap f-
-    fswap vmotion-dy f* vpstart-y f+
-    vp-setxy o> ;
+    vp-deltaxy vp-setxy o> ;
+
+forward sin-t
+
+: vp-scroll ( 0..1 addr -- )
+    >o sin-t fdup to vmotion-dt
+    vp-deltaxy vp-setxy o> ;
 
 forward anim-del
 forward >animate
@@ -282,6 +290,20 @@ forward >animate
 		THEN  EXIT  THEN
 	THEN
     THEN
+    over $18 and over 1 and 0= and IF
+	set-startxy
+	dup 2 = IF
+	    0e fdup to vmotion-dx
+	ELSE
+	    vmotion-dt vmotion-dy f*
+	THEN  to vmotion-dy  0e to vmotion-dt
+	o anim-del
+	caller-w .vp-w 32e f/ fm*
+	dup
+	$08 and IF  fdup +to vmotion-dy  THEN  fnegate
+	$10 and IF  fdup +to vmotion-dy  THEN  fdrop fdrop fdrop
+	0.333e o ['] vp-scroll >animate
+	EXIT  THEN
     caller-w >o
     tx [: act >o [ box-actor :: clicked ] o> ;] vp-needed
     vp-need-or o> ; vp-actor is clicked
diff --git a/script.fs b/script.fs
index 3e09b308f..d548e7df2 100644
--- a/script.fs
+++ b/script.fs
@@ -21,10 +21,12 @@
 : system, slit, postpone >system ;
 ' >system ' system, ' slit, rectype: rectype-eval
 
-: rec-shell ( addr u -- addr u' r:string )
+: rec-shell ( addr u -- addr u' rectype-eval | rectype-null )
     \G evaluate string + rest of command line
-    drop source drop - >in ! source >in @ /string dup >in +!
-    rectype-eval ;
+    over source drop = IF
+	drop source drop - >in ! source >in @ /string dup >in +!
+	rectype-eval
+    ELSE  2drop rectype-null  THEN ;
 ' rec-shell get-recognizers 1+ set-recognizers
 
 User sh$  cell uallot drop