Code: Select all
#!/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