Random Bits of Open Code

Check-in [0f18972173]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added config placeholder to learn-teach
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:0f189721739126b4f515c16c8b59381f6555baef
User & Date: matt 2018-08-05 20:39:14
Context
2018-08-05
21:03
Moved learn-teach app to apps directory. check-in: cb528e1bef user: matt tags: trunk
20:39
Added config placeholder to learn-teach check-in: 0f18972173 user: matt tags: trunk
2018-08-04
23:08
Fixed the help pic relative to the tabs to the left check-in: 0496171a96 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to multiapp/Makefile.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# Need to run as follows:
#
# CSC_OPTIONS="-I$PREFIX/include -L$PREFIX/lib" make deploy

SHELL = /bin/bash
CSCOPTS=

SRCFILES      = src/gui.scm src/help.scm
APPFILES      = src/learn-teach.scm
OFILES        = $(SRCFILES:%.scm=%.o)
APPOFILES     = $(APPFILES:%.scm=%.o)
EXTRASOFILES  = pkts.so dbi.so vg.so margs.so mtconfigf.so mtcommon.so mtdb.so iuputils.so
EXTRAS = $(EXTRASOFILES:%=deploytarg/%)

all : multiapp







|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# Need to run as follows:
#
# CSC_OPTIONS="-I$PREFIX/include -L$PREFIX/lib" make deploy

SHELL = /bin/bash
CSCOPTS=

SRCFILES      = src/gui.scm src/help.scm src/learn-teach-config.scm
APPFILES      = src/learn-teach.scm
OFILES        = $(SRCFILES:%.scm=%.o)
APPOFILES     = $(APPFILES:%.scm=%.o)
EXTRASOFILES  = pkts.so dbi.so vg.so margs.so mtconfigf.so mtcommon.so mtdb.so iuputils.so
EXTRAS = $(EXTRASOFILES:%=deploytarg/%)

all : multiapp

Changes to multiapp/src/help.scm.

1
2
3
4
5
6
7
8
9
;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

|







1
2
3
4
5
6
7
8
9
;;======================================================================
;; Copyright 2006-2018, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

Added multiapp/src/learn-teach-config.scm.









































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
;;======================================================================
;; Copyright 2006-2018, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(declare (unit learn-teach-config))

(module learn-teach-config
    *
  
(import scheme chicken data-structures extras posix srfi-69)

(use (prefix iup iup:)
     srfi-18
     (prefix mtconfigf configf:)
     (prefix mtcommon  common:))

;; we 
(define (read-learn-teach-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "learn-teach.config" ;; we must be on windows
			       (conc (get-environment-variable "HOME") "/.learn-teach/config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

(define (read-areas-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "areas.config" ;; we must be on windows
			       (conc (get-environment-variable "HOME") "/.learn-teach/areas.config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

;; need also write-config which does read-modify-write but it needs to be fixed
;; for now do a for-each write
;;
(define (write-learn-teach-config cfgdat #!key (infile #f))
  (let* ((learn-teachdir (conc (get-environment-variable "HOME") "/.learn-teach"))
	 (fname (or infile (conc learn-teachdir "/config"))))
    (if (not (directory-exists? learn-teachdir))(create-directory learn-teachdir #t))
    (configf:write-config cfgdat fname)))


(define (make-config-tab)
  (let* ((cmatrix (iup:matrix
		   #:alignment "ALEFT"
		   #:expand "YES"
		   #:resizematrix "YES"
		   #:scrollbar "YES"
		   #:numcol 2
		   #:numlin 20)))
    cmatrix))
  
;; end of module
)

Changes to multiapp/src/learn-teach.scm.

28
29
30
31
32
33
34



35
36
37
38
39
40
41
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
...
857
858
859
860
861
862
863

864
865
866
867
868

869
870
871
872

873
874
875
876
877
878
879

(import scheme chicken data-structures extras)
(declare (uses gui))
 
(declare (uses help))
(import help)




(import  (prefix gui gui:))

(use (prefix iup iup:)
     srfi-69 regex typed-records files matchable
     canvas-draw 
     posix vg simple-exceptions
     (prefix mtconfigf configf:)
................................................................................
		 (vote     . v)      ;; 0 or 1 to vote against/for i.e. vote 0 to cancel previous vote of 1
		 )))) ;; reference to the session pkt being voted for

(define learn-teach-pkts-dir (conc (current-directory) "/pkts"))

(if (not (directory-exists? learn-teach-pkts-dir))(create-directory learn-teach-pkts-dir #t))
	     
(define (read-learn-teach-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "learn-teach.config" ;; we must be on windows
			       (conc (get-environment-variable "HOME") "/.learn-teach/config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

(define (read-areas-config #!key (infile #f))
  (let* ((fname (or infile (if (common:windows?) ;; (get-environment-variable "HOME")
			       "areas.config" ;; we must be on windows
			       (conc (get-environment-variable "HOME") "/.learn-teach/areas.config")
			       ))))
    (if (file-exists? fname)
	(begin
	  (print "Loading config file " fname)
	  (configf:read-config fname #f #t))
	(make-hash-table))))

;; need also write-config which does read-modify-write but it needs to be fixed
;; for now do a for-each write
;;
(define (write-learn-teach-config cfgdat #!key (infile #f))
  (let* ((learn-teachdir (conc (get-environment-variable "HOME") "/.learn-teach"))
	 (fname (or infile (conc learn-teachdir "/config"))))
    (if (not (directory-exists? learn-teachdir))(create-directory learn-teachdir #t))
    (configf:write-config cfgdat fname)))

(define signal-reset-exception 
   (make-exception "Reset request recived." 'reset-request-exn))

(define (reset-request cmd)
  (let ((val #f)) ;; force redraw flag 
    (lambda (cmd)
      (case cmd
................................................................................
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))
	    (help          (help-drawing))

	    (gui           (let ((side-tabs (iup:tabs
					     #:tabtype "LEFT"
					     (car help)
					     learn
					     teach

					     )))
			     (iup:attribute-set! side-tabs "TABTITLE0" "Help")
			     (iup:attribute-set! side-tabs "TABTITLE1" "Learn")
			     (iup:attribute-set! side-tabs "TABTITLE2" "Teach")

			     side-tabs))
	    (cfgdat       (read-learn-teach-config))
	    (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	    (learn-teach-dat (make-learn-teach ;; we store the state private to this tab in here
			      ;; top-controls:  top-controls
			      subjects-tree:   subjects-tree
			      sessions-matrix:  sessions-matrix







>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>





>




>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
...
110
111
112
113
114
115
116































117
118
119
120
121
122
123
...
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854

(import scheme chicken data-structures extras)
(declare (uses gui))
 
(declare (uses help))
(import help)

(declare (uses learn-teach-config))
(import learn-teach-config)

(import  (prefix gui gui:))

(use (prefix iup iup:)
     srfi-69 regex typed-records files matchable
     canvas-draw 
     posix vg simple-exceptions
     (prefix mtconfigf configf:)
................................................................................
		 (vote     . v)      ;; 0 or 1 to vote against/for i.e. vote 0 to cancel previous vote of 1
		 )))) ;; reference to the session pkt being voted for

(define learn-teach-pkts-dir (conc (current-directory) "/pkts"))

(if (not (directory-exists? learn-teach-pkts-dir))(create-directory learn-teach-pkts-dir #t))
	     































(define signal-reset-exception 
   (make-exception "Reset request recived." 'reset-request-exn))

(define (reset-request cmd)
  (let ((val #f)) ;; force redraw flag 
    (lambda (cmd)
      (case cmd
................................................................................
			      ;; (iup:label  "Specify Your Time Slots" expand: "HORIZONTAL" fontsize: "13" alignment: "ACENTER")
			      title: "      Specify Your Time Slots" fontsize: "13"
			      (iup:vbox
			       time-slots
			       add/edit-slot)))
			    ))
	    (help          (help-drawing))
	    (config        (make-config-tab))
	    (gui           (let ((side-tabs (iup:tabs
					     #:tabtype "LEFT"
					     (car help)
					     learn
					     teach
					     config
					     )))
			     (iup:attribute-set! side-tabs "TABTITLE0" "Help")
			     (iup:attribute-set! side-tabs "TABTITLE1" "Learn")
			     (iup:attribute-set! side-tabs "TABTITLE2" "Teach")
			     (iup:attribute-set! side-tabs "TABTITLE3" "Config")
			     side-tabs))
	    (cfgdat       (read-learn-teach-config))
	    (mydata       #f) ;; hash table with pointers to all the stuff we need to keep track of, could use a struct but not sure I can safely test it for being compatible
	    (learn-teach-dat (make-learn-teach ;; we store the state private to this tab in here
			      ;; top-controls:  top-controls
			      subjects-tree:   subjects-tree
			      sessions-matrix:  sessions-matrix