newlispfanclub.alh.net

Posted: **Sun Oct 14, 2007 11:15 am**

One of my first attempts with Guiserver :

#!/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 !

Posted: **Sun Oct 14, 2007 12:27 pm**

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 all

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 all

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 all

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

to:

Code: Select all

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

Lutz recently added this :-)

m i c h a e l

Posted: **Sun Oct 14, 2007 1:55 pm**

replace:

Code: Select all

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

with

Code: Select all

(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.

Posted: **Sun Oct 14, 2007 2:52 pm**

Lutz wrote:replace:
Code: Select all
(if (or (not v) (<v> v 1e+011))
with
Code: Select all
(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 all

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

instead of :

Code: Select all

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

Yes I prefer

Code: Select all

;; 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 <

Posted: **Tue Oct 16, 2007 7:35 pm**

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.

Posted: **Wed Oct 17, 2007 9:07 am**

newdep wrote:...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 ;-)

Posted: **Tue Oct 30, 2007 11:43 am**

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

Posted: **Tue Oct 30, 2007 1:59 pm**

Maurizio wrote: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).
:)

Posted: **Tue Oct 30, 2007 3:53 pm**

Oh, yes I've seen the problem (well, I hope !)...
I modified my script like this :

Code: Select all

(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.

Posted: **Wed Oct 31, 2007 10:13 am**

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 all

(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]

Posted: **Wed Oct 31, 2007 4:17 pm**

Now I understand (Well, at last !) ;)
Maybe something like this :

Code: Select all

(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) ;)

newlispfanclub.alh.net

Just a try (not converted) ;)

Just a try (not converted) ;)