Just a try (not converted) ;)

[newBert]

One of my first attempts with Guiserver :

Code Select Expand

#!/usr/bin/newlisp
;================================================
; Context and GUI
; ----- newlisp 9.1.12 --------- août 2007 -----
; Bertrand Carette (aka newBert)
;================================================
[text]
Resistors are small tubular parts rimmed with colored stripes (usually 3).
These stripes show the numerical value of the resistor according to the
following code :

Each color corresponds to one of the numerals from zero to nine:
black=0, brown=1, red=2, orange=3, yellow=4, green=5, blue=6, purple=7,
    gray=9, white=10.

Resistor is positioned so as to put the colored stripes on the left.
The value of the resistor, expressed in ohm, is obtained by reading the
stripes from the left : the first two stripes show the first two numerals
of the value, next the third stripes show the amount of zeros.

Example:
yellow, purple and green stripes => 4700000 Ohm or 4700 kOhm or 4.7 MOhm.
[/text]

(context 'Application)
(define (Application:Application)
; Constants and variables
; -> color codes (cc) for the values from zero to nine :
; black = 0     brown = 1   red = 2
; orange = 3   yellow = 4   green = 5
; blue = 6     purple = 7 grey = 8
; white = 9
(set 'cc '( (0.00 0.00 0.00) (0.68 0.31 0.00) (1.00 0.00 0.00)
(1.00 0.54 0.09) (1.00 1.00 0.00) (0.00 1.00 0.00)
(0.00 0.00 1.00) (0.39 0.00 0.78) (0.50 0.50 0.50)
(1.00 1.00 1.00)))
; -> list of the three colors (black by default)
(set 'coul (list (cc 0) (cc 0) (cc 0)))
; Building the main window
(gs:frame 'Fen 100 100 280 240 "Color Codes")
(gs:set-flow-layout 'Fen "center")
; -> creating then canvas where we'll draw the resistor
(gs:panel 'PanCanevas 250 120)
(gs:set-color 'PanCanevas '(0.98 0.98 0.98))
(gs:set-bevel-border 'PanCanevas "lowered")
(gs:canvas 'Can)
(gs:set-size 'Can 250 120)
(gs:add-to 'PanCanevas 'Can)
; -> drawing the resistor
(dessine-resistance (coul 0) (coul 1) (coul 2))
; -> creating the entry field
(gs:panel 'PanEntree )
(gs:set-border-layout 'PanEntree )
(gs:label 'Text "Value of the resistor (Ohm):")
(gs:text-field 'Entree 'change-couleurs 20)
(gs:add-to 'PanEntree 'Text "north" 'Entree "south")
; -> buttons
(gs:panel 'PanBouton)
(gs:set-flow-layout 'PanBouton "center" 70 2)
(gs:button 'BMontre 'evalue-entree "Show")
(gs:button 'BQuitte 'quitte "Quit")
(gs:add-to 'PanBouton 'BMontre 'BQuitte)
; -> laying out the main frame
(gs:add-to 'Fen 'PanCanevas 'PanEntree 'PanBouton)
(gs:set-visible 'Fen true)
; Event loop
(gs:listen) )

(define (dessine-resistance c1 c2 c3)
; Draw a resistor with three colored stripes
(gs:set-canvas 'Can)
; -> drawing
(gs:set-stroke 2.0)
(gs:draw-line 'Fil 10 50 240 50 gs:orange) ;wire
(gs:set-stroke 1.0)
(gs:fill-rect 'Res 65 30 120 40 gs:lightGray)
; -> three stripes (black by default)
(gs:set-stroke 0.0)
(gs:fill-rect 'R1 80 30 17 40 c1)
(gs:fill-rect 'R2 104 30 17 40 c2)
(gs:fill-rect 'R3 128 30 17 40 c3)
; -> updating the canvas
(gs:update))

(define (evalue-entree id text)
(gs:get-text 'Entree 'change-couleurs))

(define (change-couleurs id text)
; Displays the colors which correspond to the input values
; -> getting and evaluating entries
(set 'vlch  (base64-dec text))
(set 'v (float vlch))
(if (or (not v) (<v> v 1e+011))
(signale-erreur)) ; bad input
(set 'li (dup 0 3)) ; list of the 3 codes to display
(set 'logv (int (log v 10))) ; integer part of the logarithm
(set 'ordgr (pow 10 logv)) ; idea of the size
; -> extracting the first significant numeral :
(nth-set (li 0) (/ v ordgr)) ; integer part
(set 'decim (sub (div v ordgr) (li 0))) ; decimal part
; -> extracting the second significant numeral :
(nth-set (li 1) (round (mul decim 10)))
; -> amount of zeros to place beside the 2 significant numerals :
(nth-set (li 2) (- logv 1))
; -> coloring the 3 stripes :
(dotimes (n 3)
(nth-set (coul n) (cc (li n))))
(dessine-resistance (coul 0) (coul 1) (coul 2))
; -> focus on entry field
(gs:request-focus 'Entree))

(define (signale-erreur)
; Displays "error" then gets back to entry field
(gs:clear-text 'Entree)
(gs:set-text 'Entree "Error !")
(sleep 1000); pause 1 seconde
(gs:clear-text 'Entree)
(gs:request-focus 'Entree)
(gs:listen))

(define (quitte)
(exit))

(context MAIN)

;; initialisation GUI-Server
(if (= ostype "Win32")
    (load (string (env "PROGRAMFILES") "/newlisp/guiserver.lsp"))
    (load "/usr/share/newlisp/guiserver.lsp"))
(gs:init)

;; main program
(Application)
(exit)      
;; end of script

Sorry for some french words left here and there !

[m i c h a e l]

Hi newBert!



I tried your program (I like the graphic representation of the resistor), but I keep getting errors. With "4700000" in the text field and a click on the show button or a press of the return key, I get the following:

Code Select Expand

invalid function : (<v> v 1e+11)
called from user defined function Application:change-couleurs
called from user defined function gs:listen
called from user defined function Application
server shutdown


With no text in the field, a click on show produces this:

Code Select Expand

string expected in function base64-dec : text
called from user defined function Application:change-couleurs
called from user defined function gs:listen
called from user defined function Application
server shutdown


Also, if you want to, you can change the following:

Code Select Expand

;; initialisation GUI-Server
(if (= ostype "Win32")
    (load (string (env "PROGRAMFILES") "/newlisp/guiserver.lsp"))
    (load "/usr/share/newlisp/guiserver.lsp"))


to:

Code Select Expand

;; initialisation GUI-Server
(load (append (env "NEWLISPDIR") "/guiserver.lsp"))


Lutz recently added this :-)



m i c h a e l

[Lutz]

replace:

Code Select Expand

(if (or (not v) (<v> v 1e+011))

with

Code Select Expand

(if (or (not v) (= v 1e+011))

this probably happened when pasting the post.



Lutz



ps: in Application:change-couleurs 'text' could be checked for 'nil' in case no number is entered.

[newBert]

replace:

Code Select Expand

(if (or (not v) (<v> v 1e+011))

with

Code Select Expand

(if (or (not v) (= v 1e+011))

this probably happened when pasting the post.



Lutz



ps: in Application:change-couleurs 'text' could be checked for 'nil' in case no number is entered.

Hi Lutz,



Oh yes ! Thank you for pointing that to me.

I don't know how the code was transformed like this during the "copy/paste" ?

Here's the original :

Code Select Expand

(if (or (= v 0) (< v 10) (> v 1e+011))
instead of :

Code Select Expand

(if (or (not v) (<v> v 1e+011))

Yes I prefer

Code Select Expand

;; initialisation GUI-Server
(load (append (env "NEWLISPDIR") "/guiserver.lsp"))
but I don't get used yet to the last release of NewLISP :)



P.S.: I found the "bug"! I must check "disable HTLM in this post" to display correctly > and <

[newdep]

Hee nice tool ..I did not know that Ohm went upto 900 in restistors.. ;-)

(But im now getting the trick behind the color codes..)



Norman.

[newBert]

...I did not know that Ohm went upto 900 in restistors.. ;-)

Norman.

Neither do I ... I don't know much about resistors. This script was just an execise for me ;-)

[Maurizio]

why it is needed the last line (gs:listen) of the procedure

signale-erreur ?



if I type a correct value the program flows out of

change-couleurs wihout calling gs:listen, and it continue to work.

Why it is needed in case of error ?



Regards



Maurizio

[newBert]

why it is needed the last line (gs:listen) of the procedure

signale-erreur ?



if I type a correct value the program flows out of

change-couleurs wihout calling gs:listen, and it continue to work.

Why it is needed in case of error ?



Regards



Maurizio

It is needed to remain in then event loop.

Try to remove it ... and you'll exit from the application after a bad input (0, <10 or > 1e+011).

:)

[newBert]

Oh, yes I've seen the problem (well, I hope !)...

I modified my script like this :

Code Select Expand

(context 'Application)
(define (Application:Application)
; Constants and variables
; -> color codes (cc) for the values from zero to nine :
; black = 0     brown = 1   red = 2
; orange = 3   yellow = 4   green = 5
; blue = 6     purple = 7 grey = 8
; white = 9
(set 'cc '( (0.00 0.00 0.00) (0.68 0.31 0.00) (1.00 0.00 0.00)
(1.00 0.54 0.09) (1.00 1.00 0.00) (0.00 1.00 0.00)
(0.00 0.00 1.00) (0.39 0.00 0.78) (0.50 0.50 0.50)
(1.00 1.00 1.00)))
; -> list of the three colors (black by default)
(set 'coul (list (cc 0) (cc 0) (cc 0)))
; Building the main window
(gs:frame 'Fen 100 100 280 240 "Color Codes")
(gs:set-flow-layout 'Fen "center")
; -> creating then canvas where we'll draw the resistor
(gs:panel 'PanCanevas 250 120)
(gs:set-color 'PanCanevas '(0.98 0.98 0.98))
(gs:set-bevel-border 'PanCanevas "lowered")
(gs:canvas 'Can)
(gs:set-size 'Can 250 120)
(gs:add-to 'PanCanevas 'Can)
; -> drawing the resistor
(dessine-resistance (coul 0) (coul 1) (coul 2))
; -> creating the entry field
(gs:panel 'PanEntree )
(gs:set-border-layout 'PanEntree )
(gs:label 'Text "Value of the resistor (Ohm):")
(gs:text-field 'Entree 'change-couleurs 20)
(gs:set-text 'Entree " ")
(gs:add-to 'PanEntree 'Text "north" 'Entree "south")
; -> buttons
(gs:panel 'PanBouton)
(gs:set-flow-layout 'PanBouton "center" 70 2)
(gs:button 'BMontre 'evalue-entree "Show")
(gs:button 'BQuitte 'quitte "Quit")
(gs:add-to 'PanBouton 'BMontre 'BQuitte)
; -> laying out the main frame
(gs:add-to 'Fen 'PanCanevas 'PanEntree 'PanBouton)
(gs:set-visible 'Fen true)
; Event loop
(gs:listen) )

(define (dessine-resistance c1 c2 c3)
; Draw a resistor with three colored stripes
(gs:set-canvas 'Can)
; -> drawing
(gs:set-stroke 2.0)
(gs:draw-line 'Fil 10 50 240 50 gs:orange) ;wire
(gs:set-stroke 1.0)
(gs:fill-rect 'Res 65 30 120 40 gs:lightGray)
; -> three stripes (black by default)
(gs:set-stroke 0.0)
(gs:fill-rect 'R1 80 30 17 40 c1)
(gs:fill-rect 'R2 104 30 17 40 c2)
(gs:fill-rect 'R3 128 30 17 40 c3)
; -> updating the canvas
(gs:update))

(define (evalue-entree id text)
(gs:get-text 'Entree 'change-couleurs))

(define (change-couleurs id text)
; Displays the colors which correspond to the input values
; -> getting and evaluating entries

(set 'vlch  (base64-dec text))
(set 'v (float vlch))
(if (or (= v 0) (< v 10) (> v 1e+011))
(signale-erreur)) ; bad input
(set 'li (dup 0 3)) ; list of the 3 codes to display
(set 'logv (int (log v 10))) ; integer part of the logarithm
(set 'ordgr (pow 10 logv)) ; idea of the size
; -> extracting the first significant numeral :
(nth-set (li 0) (/ v ordgr)) ; integer part
(set 'decim (sub (div v ordgr) (li 0))) ; decimal part
; -> extracting the second significant numeral :
(nth-set (li 1) (round (mul decim 10)))
; -> amount of zeros to place beside the 2 significant numerals :
(nth-set (li 2) (- logv 1))
; -> coloring the 3 stripes :
(dotimes (n 3)
(nth-set (coul n) (cc (li n))))
(dessine-resistance (coul 0) (coul 1) (coul 2))
; -> focus on entry field
(gs:request-focus 'Entree))

(define (signale-erreur)
; Displays "error" then gets back to entry field
(gs:clear-text 'Entree)
(gs:set-text 'Entree "Error !")
(sleep 1000); pause 1 seconde
(gs:set-text 'Entree " ")
(gs:request-focus 'Entree)
(gs:listen))

(define (quitte)
(exit))

(context MAIN)

;; initialisation GUI-Server
(if (= ostype "Win32")
    (load (string (env "PROGRAMFILES") "/newlisp/guiserver.lsp"))
    (load "/usr/share/newlisp/guiserver.lsp"))
(gs:init)

;; main program
(Application)
(exit)      
;; end of script
See the (gs:set-text 'Entree " ") after (gs:text-field 'Entree 'change-couleurs 20) and in the (signale-erreur) procedure.

[Maurizio]

I didn't understand why the (gs:listen) call was needed in the signale-erreur procedure.

After a little investigation I found what I think is a little problem :



if you completely comment the body of  signale-erreur, leaving only :

(define (signale-erreur)),

and then you enter an invalid value, the program complains,

showing in the log area of the developement environment the following message :

value expected in function log : v



This is what happens :

the signale-erreur returns, but the program is unable to cope with the

erroneous value, and when (set 'logv (int (log v 10)))  is called

it exit abnormally from the change-couleurs procedure and from the message loop.



The call (gs:listen) you put in signale-erreur make the program re-enter a message loop while it is still in the processing of a current call.

The signale-erreur is not actually terminated, but remains in a suspended state, so is the change-couleurs and the evalue-entree.



So there are now two gs:listen in progress.

if you now enter another error you get a third level of processing.

If you continue to enter errors eventually (after several hundredths of calls) the program should crash on stack overflow.

I suppose the cure is to remove the gs:listen from signale-erreur, to assemble the statements after the call to signale-erreur in a new procedure (e.g calc-and-show), to modify the change-couleurs as follows :

Code Select Expand


(define (change-couleurs id text)
   ; Displays the colors which correspond to the input values
   ;   -> getting and evaluating entries

   (set 'vlch  (base64-dec text))  
   (set 'v (float vlch))  
   (if (or (= v 0) (<v> v 1e+011))
      (signale-erreur)
      (calc-and-show v))


in this way, if signale-erreur is called, the calc-and-show it is not, and vice-versa.



Apart this little problem I found it is a nice program.

Regards

Maurizio





when

[/code]

[newBert]

Now I understand (Well, at last !) ;)

Maybe something like this :

Code Select Expand

(define (change-couleurs id text)
; Displays the colors which correspond to the input values
; -> getting and evaluating entries
(set 'vlch  (base64-dec text))
(set 'v (float vlch))
(if (or (= v 0) (< v 10) (> v 1e+011))
(signale-erreur) ; bad input
(calc-and-show v)))

(define (calc-and-show v)
(set 'li (dup 0 3)) ; list of the 3 codes to display
(set 'logv (int (log v 10))) ; integer part of the logarithm
(set 'ordgr (pow 10 logv)) ; idea of the size
; -> extracting the first significant numeral :
(nth-set (li 0) (/ v ordgr)) ; integer part
(set 'decim (sub (div v ordgr) (li 0))) ; decimal part
; -> extracting the second significant numeral :
(nth-set (li 1) (round (mul decim 10)))
; -> amount of zeros to place beside the 2 significant numerals :
(nth-set (li 2) (- logv 1))
; -> coloring the 3 stripes :
(dotimes (n 3)
(nth-set (coul n) (cc (li n))))
(dessine-resistance (coul 0) (coul 1) (coul 2))
; -> focus on entry field
(gs:request-focus 'Entree))

(define (signale-erreur)
; Displays "error" then gets back to entry field
(gs:set-text 'Entree "Error !")
(sleep 1000); pause 1 seconde
(gs:set-text 'Entree " ")
(gs:request-focus 'Entree))
Thank you for pointing that (I'm a real newbie) ;)