| 4th.CoSy Textual User Interface 
| 
| This is not well ( functionally structured ) . Needs to be replaced building upon the vocab in ` ./CoSy/Job.f 
|
| Author: Bob Armstrong building upon resources created by 
|  Danny Reinhold / Reinhold Software Services
| upon the IUP GUI toolkit:  Copyright © 1994-2005 Tecgraf / PUC-Rio and PETROBRAS S/A.
| Reva's license terms also apply to this file

cr ." | Tui begin | " type cr

~ needs ui/gui exit~ 
~ui

: key-cS-cb	 ( handle xt -- handle )	z" K_cS"		set-callback  ;

: key-F1-cb	 ( handle xt -- handle )	z" K_F1"		set-callback  ;
: key-F2-cb	 ( handle xt -- handle )	z" K_F2"		set-callback  ;
: key-F3-cb	 ( handle xt -- handle )	z" K_F3"		set-callback  ;
: key-F4-cb	 ( handle xt -- handle )	z" K_F4"		set-callback  ;
: key-F5-cb	 ( handle xt -- handle )	z" K_F5"		set-callback  ;
: key-F6-cb	 ( handle xt -- handle )	z" K_F6"		set-callback  ;
: key-sF6-cb  	 ( handle xt -- handle )	z" K_sF6"		set-callback  ;

: key-F7-cb	 ( handle xt -- handle )	z" K_F7"		set-callback  ;
: key-F8-cb	 ( handle xt -- handle )	z" K_F8"		set-callback  ;
: key-F9-cb	 ( handle xt -- handle )	z" K_F9"		set-callback  ;
: key-F10-cb 	 ( handle xt -- handle )	z" K_F10"		set-callback  ;
: key-F11-cb 	 ( handle xt -- handle )	z" K_F11"		set-callback  ;
: key-F12-cb 	 ( handle xt -- handle )	z" K_F12"		set-callback  ;


: insert  ( handle a n -- handle )  attr: INSERT ;

: topmost ( handle b -- handle ) if " YES" else " NO" then attr: TOPMOST ; 

exit~ with~ ~iup with~ ~ui  

alias: gui gui-main-loop

: quit callback gui-close ; 
: gbye callback bye ; 

| : cb ( xt -- xt )  compile p[ add-callback gui-default ]p ;

variable textwdo 	2variable res 
variable reswdo 	2variable txt 
variable statewdo 	2variable state 

variable sWdo
variable llWdo
variable btnswdo


: win> ( handle -- str ) @ getval --bc str ;
: >win ( str handle -- ) {  @ -rot setval drop } onvan ;

` res refs+> value `res

| Kludges to simplify displaying and storing R obs 
 ` resvar refs+> value `resvar 
: >resvar> dup : >resvar `resvar Dv! ;
: resvar `resvar Dv@ ;
 
: res> reswdo @ getval --bc _str ; | cluge to drop trailing cr from ' lst
 
: saverestxt res> R `res v! ;
: rtype ( a n -- ) reswdo @ -rot setval drop ; 
: >res ( str -- ) dup van rtype ref0del ;

: ->  >resvar> R swap v@ ; 	| 20160525 | eliminated ' stype . 
: >-  res> R resvar v!  ;

` text refs+> value `text 

: text> textwdo @ getval str nip ; : text>> text> lfVM ; | 20191226

: >text ( str -- ) { textwdo @ -rot setval drop } onvan ;	| Mon.Jul,20130715
| : >text ( str -- ) textwdo @ z" VALUE"  --bca van zt IupStoreAttribute _i ;  
| Insert string in ` text window . Replaces current text in ` text window .
| Necessary for replacing ` text with ` text from another .csy file . 20180708

: savetext text> R `text v! ;
| : savepos  d1 @  getPos `( sys Tui posXY )` Dv! ;	| Stores current upper left corner for restart

: savecaret textwdo @ getcaret ` sys Dv@ ` Tui v@ ` caret v! ; 
: saveStatecaret statewdo @ getcaret ` sys Dv@ ` Tui v@ ` State v@ ` caret v! ; 	| 20220303
 
: state>  statewdo win> ;
: >state ( str -- ) { statewdo @ -rot setval drop } onvan ;
: savestate state> " state" (sym) Dv! ; 

: insert-state callback statewdo @ reswdo @ getval --bc insert drop ; 

: saveLastsave ymd.hms R " lastSave" (sym) v! ;

| prior  ~util.save  |

: save ( callback )  savetext  ." 5 " saverestxt  ." 4 " savestate  ." 3 "
   bkuplast  ." 2 " R lst>str  ." 1 " CoSyStartFile ." 0 "  >F saveLastsave savecaret saveStatecaret ;

| see | 20220101 |

: $.sUpdate spon ." $tack : "  $.s  spoff  
   sWdo @  z" TITLE"  spoolbuf lcount ( 2dup type cr ) zt IupStoreAttribute drop ; 

` L refs+> value L   ` LL refs+> value LL 

 s"  last xeq | " refs+> value llLbl 

: llUpdate llWdo @  z" TITLE"  llLbl L cL >r> van zt ( dup ztype cr )
	IupStoreAttribute drop r> refs- ; 

: curln ( wdo -- a n ) | line_under_cursor 
    @ caret-y? line-text? --bc ;

: getcurln ( wdo -- str ) curln 2dup str addr L rplc ;

0 [IF]
: evalsel 
  ." Caret position: "  textwdo @  caret?  type cr
  ." Selection: "  textwdo @  selection?  type cr
  ." Evaluating selected text: " 
   textwdo @  selected-text?  2dup type cr  eval
   gui-default ; 
(  ' evalsel   16 cb: eval-selected-text )
: eval-selected-text callback evalsel ; 
[THEN]


: type>res (spool) 2dup res 2! rtype ;

| Evaluate line under cursor 
 
| : evaln ( ? -- ? ) { getcurln eval } catch ?dup if ['] caught type>res
|	 $.s ;then
|	depth 0 =if nil then ;

: f6 { getcurln eval } catch ?dup if ['] caught type>res $.s cr DMP 
	nil >R0 ;then 
    depth 0 =if nil then
    { >R0> ['] lst type>res } catch ?dup if ['] caught type>res ;then 
	llUpdate  $.sUpdate ;

: sf6 { getcurln ['] eval type>res } catch ?dup if ['] caught type>res then
	llUpdate  $.sUpdate ;

|
| : f3 { getcurln eval } catch ?dup if ['] caught type>res ;then 
|    depth 0 =if nil then >R0> ['] lst type>res 
| 	llUpdate  $.sUpdate ;

|  : eval-current-line callback f6 ; 
 
| : f3 evaln LL "  |>| " swap insert  ; 

 
| Evaluate pure CoSy object line . display result 
| : CSinterpret { getcurln eval dup addr r rplc r ['] lst type>res } catch
|   ?dup if ['] caught type>res then  llUpdate $.sUpdate ; 

: insert-text callback textwdo @  reswdo @ getval --bc insert drop ; 

| : insert-res callback @ ( "  | |>| " insert ) reswdo @ getval --bc insert drop ; 

| : insert-R0 callback @ ( "  | |>| " insert ) R0 insert drop ; 

: ins-hm ( wdo -- ) @ |hm| insert drop ;
 
| : ins-ymdhms textwdo @ ymdhms_ insert drop ; 
| : ins-ymdhm @ ymdhm s"  | " enc braket ['] insert onvan drop ; 
| : ins-ymd.hm @ |ymd.hm|_ insert drop ; 	| don't know why bombs 
: ins-ymd.hm @ ymd.hm_ insert drop ; 

: ins-dayln @ toDayln insert drop ;

: spout (spool) rtype ;

: fileDialog : file-dlg	( -- str ) 
  file-open-dialog[
    " YES" attr: MULTIPLEFILES ]fd
  popup getval unixslash str swap destroy ;  

 ." | \\/ DIALOG DEF \\/ | " $.s cr
| ################ \/ DIALOG DEF \/ | ##############===================== |
variable d1  
: define-dialog1 ( -- dialoghandle )
 | 32 32 dlg-icon-bitmap iup-image  dup " 0 0 255" attr: 0  dup " 255 0 255"  attr: 1  dup  z" myimage" swap iup-set-handle drop
  
  dialog[
   spacer
   " last executed line |                     " label[ dup llWdo ! ]w
   spacer
   
| \/ ` res WINDOW \/ | ===================== |

   "  res" label[  ]w
     editbox[ 
     ` sys Dv@ ` Tui v@ ` res v@ van size 
     expand  " Result " tip 
     ` sys Dv@ ` Tui v@ ` font v@ van 
     attr: FONT 
 
    { ` res.help >resvar> R swap v@ >res } key-F1-cb
    
 	{ reswdo curln str www } z" K_cF9" set-callback 
    { reswdo ins-hm } key-F11-cb
	{ >- save reswdo ins-ymd.hm } z" K_sF11" set-callback

	{ reswdo ins-dayln } key-F12-cb
	
	{ >- save } key-cS-cb | save res text to resvar . save envirnment 
	
     res 2@ setval dup reswdo ! ]w
| /\ ` res WINDOW  /\ | ===================== |

	spacer

| \/ ` text WINDOW \/ | ===================== |	
    "  text" label[  ]w
    editbox[ 
    ` sys Dv@ ` Tui v@ ` text v@ van size 
     expand  " Working Text" tip 
     ` sys Dv@ ` Tui v@ ` font v@ van  attr: FONT 
	| " 8" attr: TABSIZE
    | " APLSans::10" attr: FONT

| \/ ` text KEY DEFS \/ | ===================== |
 
    { ` help >resvar> R swap v@ >res } key-F1-cb 

|     { { f6 insert-text  gui-default } add-callback gui-default } key-F3-cb
	 
     ['] insert-text key-F5-cb

|    { textwdo insert-res add-callback gui-default } z" K_sF5" set-callback 
     
|	 ['] insert-R0 z" K_sF5" set-callback   | bombs [ for good reason ] 
	 
	 { { save `res `resvar  Dv! textwdo f6  gui-default } add-callback gui-default } key-F6-cb
	 
	 { { textwdo sf6  gui-default } add-callback gui-default } key-sF6-cb
 
     { curln str shell> } z" K_cF6" set-callback
 
|	 ['] fs6  z" K_sF6" set-callback

	 
|	 { { fs6 gui-default } add-callback gui-default } key-F7-cb 
|	{ { CSinterpret gui-default } add-callback gui-default } key-F7-cb
	 
	 { curln str -> } z" K_F9" set-callback 
	 { textwdo curln str www } z" K_cF9" set-callback 
	 
	 { textwdo ins-hm save } key-F11-cb
	 { textwdo ins-ymd.hm } z" K_sF11" set-callback
 
	 { textwdo ins-dayln } key-F12-cb
 
	 ['] save key-cS-cb 

| /\ KEY DEFS /\ | ===================== |

	txt 2@ setval dup textwdo ! ]w
	spacer

| \/ ` state WINDOW \/ | ===================== |
 
   "  state" label[  ]w
     editbox[ 
     ` sys Dv@ ` Tui v@ ` state v@ van size 
     expand  " state " tip 
     ` sys Dv@ ` Tui v@ ` font v@ van attr: FONT 

| \/ | Key DEFS | \/ |
    { ` help >resvar> R swap v@ >res } key-F1-cb

     ['] insert-state key-F5-cb  
	 
	 { { save `res `resvar Dv! statewdo f6  gui-default } add-callback
      gui-default } key-F6-cb 
	 
|	 { save `res `resvar Dv! statewdo f6 gui-default } key-F6-cb 
	 
	{ { statewdo sf6  gui-default } add-callback gui-default } key-sF6-cb 

	{ statewdo curln str www } z" K_cF9" set-callback 
    { statewdo ins-hm } key-F11-cb
	{ statewdo ins-ymd.hm } z" K_sF11" set-callback
	
	{ statewdo ins-dayln } key-F12-cb
	
	{ save } key-cS-cb | save text to state . save envirnment 
	 
     state 2@ setval dup statewdo ! ]w
| /\ ` state WINDOW /\ | ===================== |
	spacer
 "  $tack | ( stack contents in hex )  $.s |                                        "  label[ dup sWdo ! ]w


| \/ BUTTON DEFS \/ | ===================== |
	hbox[ dup btnswdo ! 

      | " Eval current line" button[ action: eval-current-line  " ( Evaluate the current line! )" tip  ]w
	  
      | " Eval Selection!" button[ action: eval-selected-text  " Evaluate selected text!" tip  ]w
	   
	  " Get file name(s)" button[ { fileDialog >t0> ['] lst type>res } action " fileDialog >t0> lst" tip ]w
	  
	  " Reset stack " button[ { { reset $.sUpdate gui-default } add-callback gui-default } action " reset" tip ]w
	  
|	  " D>" button[ { { ['] D> spout gui-default } add-callback gui-default } action " ' D> spout ( dumps first 8 cells of object on ToS w/o change ) "  tip ]w
	  
	  " o" button[ { { ['] o spout gui-default } add-callback gui-default } action " ' o spout ( displays object on ToS w/o change ) "  tip ]w
	  
	  " over o drop" button[ { { over ['] o spout drop $.sUpdate gui-default } add-callback gui-default } action " over ' o spout drop ( displays second object on stack w/o change ) "  tip ]w
	  
	  " lst " button[ { { ['] lst spout $.sUpdate gui-default } add-callback gui-default } action " ' lst spout ( displays object on ToS consuming , freeing if refs = 0 ) "  tip ]w

	   " Dnames " button[ { { Dnames ['] lst spout $.sUpdate gui-default } add-callback gui-default } action " ' names in R "  tip ]w
	  
	   " lastSave " button[ { { R s" lastSave" v@ ['] lst spout $.sUpdate gui-default } add-callback gui-default } action " ' TS of last Save "  tip ]w

	   | " Reset stack 2 " button[ { reset $.sUpdate } cb action " reset" tip ]w
      
	|   " Save " button[ action: save " save everything " tip  ]w
	  
	| " Quit" button[  action: quit  " ( Quit Tui )" tip  ]w
	|  " bye" button[  action: gbye " ( exit Reva.CoSy )" tip  ]w

	  ]c
| /\ BUTTON DEFS /\ | ===================== |


  ]d FullCoSyFile .. ` \ ss -2 _at cut van title 	
  | 20210201 | changed from CoSyFile | 20201005.1321 | changed from COSYSTARTFILE 

 ; 

 ." | /\\ DIALOG DEF /\\ | " $.s cr
| /\ DIALOG DEF /\ | ===================== |  

: getset ec van txt 2!  ec van res 2!
   ec van state 2!  define-dialog1 d1 ! ;

| : getset R `text v@ van txt 2!  R `res v@ van res 2!
|   s" state" Dv@ van state 2!  define-dialog1 d1 ! ;

getset 

variable tpmst 

: go d1 @ ` sys Dv@ ` Tui v@ ` posXY v@ lst>stk_ show-xy 0 topmost tpmst ! 
   ` res Dv@ >res 
   ` text Dv@ >text  ` sys Dv@ ` Tui v@ ` caret v@ textwdo @ setcaret 
   ` state Dv@ >state 
   ` sys Dv@ ` Tui v@ ` State v@ ` caret v@  statewdo @ setcaret 
	 gui-main-loop  
	tpmst @ hide destroy ;
 
| : go d1 @ 0 0 show-xy 0 topmost >r  gui-main-loop  r> hide destroy  ;

cr $.s ." | Tui end | " cr
