Menu
▾
▴
[Win32forth-cvs] win32forth/demos WINCLOCK.F,1.1,1.2
|
From: Jos v.d.V. <jo...@us...> - 2005-10-05 15:31:32
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29330/demos Modified Files: WINCLOCK.F Log Message: Centered the window of the improved version of Andrew Stephenson. Index: WINCLOCK.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/WINCLOCK.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** WINCLOCK.F 21 Dec 2004 00:18:52 -0000 1.1 --- WINCLOCK.F 5 Oct 2005 15:31:21 -0000 1.2 *************** *** 22,42 **** -1 value prev-y : moveto ( x y -- ) ! 0max screen-height 4 - min swap 0max screen-width 4 - min swap ! bit-originy + swap bit-originx + swap ! over prev-x = over prev-y = and ! IF 2drop ! ELSE 2dup to prev-y ! to prev-x MoveTo: demo-dc ! THEN ; : lineto ( x y -- ) ! 0max screen-height 4 - min swap 0max screen-width 4 - min swap ! bit-originy + swap bit-originx + swap ! over prev-x = over prev-y = and ! IF 2drop ! ELSE 2dup to prev-y ! to prev-x LineTo: demo-dc then ; --- 22,43 ---- -1 value prev-y + : new-point-chk ( x y -- x y true | false ) + 0max screen-height 4 - min swap 0max screen-width 4 - min swap + bit-originy + swap bit-originx + swap + over prev-x = over prev-y = and + if 2drop false ( don't draw ) + else 2dup to prev-y + to prev-x true ( do draw ) + then ; + : moveto ( x y -- ) ! new-point-chk ! if MoveTo: demo-dc ! then ; : lineto ( x y -- ) ! new-point-chk ! if LineTo: demo-dc then ; *************** *** 132,135 **** --- 133,141 ---- :M StartSize: ( -- width height ) \ starting window size 480 480 + + ;M + + :M StartPos: ( -- x y ) \ starting postion on screen + CenterWindow: Self ;M *************** *** 186,190 **** : >screeny ( n1 -- n2 ) screen-width 480 */ ; ! : makesin ( -- ) cr --- 192,196 ---- : >screeny ( n1 -- n2 ) screen-width 480 */ ; ! (( : makesin ( -- ) cr *************** *** 203,213 **** >screeny dup r> scale-y */ swap 1 and + negate center-y + ; : xy-scale ( 6deg scale -- x1 y1 ) >r ! dup sintbl +CELLS @ >screenx dup r@ center-x */ ! swap 1 and + center-x + ! swap 15 + sintbl +CELLS @ >screeny dup r> scale-y */ ! swap 1 and + negate center-y + ; -1 value last-hour --- 209,223 ---- >screeny dup r> scale-y */ swap 1 and + negate center-y + ; + )) + + : sin ( deg -- x ) 60 mod sintbl +CELLS @ ; + : cos ( deg -- y ) 15 + sin negate ; + : roundup ( x sx -- x' ) swap 1 and + ; + : xy-scale ( 6deg scale -- x1 y1 ) >r ! dup sin >screenx dup r@ center-x */ roundup center-x + ! swap cos >screeny dup r> scale-y */ roundup center-y + ; -1 value last-hour *************** *** 220,248 **** 0 value this-second ! : .sec ( n1 -- ) >r ! center-x center-y r@ center-x 20 - xy-scale line ! r@ 1- 020 xy-scale r@ center-x 20 - xy-scale line ! r@ 1+ 020 xy-scale r@ center-x 20 - xy-scale line ! center-x center-y r@ 1- 020 xy-scale line ! center-x center-y r@ 1+ 020 xy-scale line r>drop ; ! : .min ( n1 -- ) >r ! center-x center-y r@ center-x dup 10 / - xy-scale line ! r@ 1- center-x 3 / xy-scale r@ center-x dup 10 / - xy-scale line ! r@ 1+ center-x 3 / xy-scale r@ center-x dup 10 / - xy-scale line ! center-x center-y r@ 1- center-x 3 / xy-scale line ! center-x center-y r@ 1+ center-x 3 / xy-scale line r>drop ; ! : .hr ( n1 -- ) >r ! center-x center-y r@ center-x 2 / xy-scale line ! r@ 2 - center-x 3 / xy-scale r@ center-x 2 / xy-scale line ! r@ 2 + center-x 3 / xy-scale r@ center-x 2 / xy-scale line ! center-x center-y r@ 2 - center-x 3 / xy-scale line ! center-x center-y r@ 2 + center-x 3 / xy-scale line r>drop ; --- 230,265 ---- 0 value this-second ! : cxy center-x center-y ; ! : inner 20 xy-scale ; ! : outer center-x 20 - xy-scale ; ! : innersc center-x 3 / xy-scale ; ! : outermin center-x dup 10 / - xy-scale ; ! : outerhr center-x 2/ xy-scale ; ! ! : .sec ( sec -- ) >r ! cxy r@ outer line ! r@ 1- inner r@ outer line ! r@ 1+ inner r@ outer line ! cxy r@ 1- inner line ! cxy r@ 1+ inner line r>drop ; ! : .min ( min -- ) >r ! cxy r@ outermin line ! r@ 1- innersc r@ outermin line ! r@ 1+ innersc r@ outermin line ! cxy r@ 1- innersc line ! cxy r@ 1+ innersc line r>drop ; ! : .hr ( hr -- ) >r ! cxy r@ outerhr line ! r@ 2 - innersc r@ outerhr line ! r@ 2 + innersc r@ outerhr line ! cxy r@ 2 - innersc line ! cxy r@ 2 + innersc line r>drop ; *************** *** 306,314 **** ccolor >color line-color 60 0 ! DO I cdiam xy-scale 2dup 1+ swap 1+ swap line LOOP 5 +TO cdiam cdiam center-x 30 - > IF 16 TO cdiam ! THEN ; : .hms ( -- ) --- 323,332 ---- ccolor >color line-color 60 0 ! DO \ draws dots (lines 1 pixel long) ! I cdiam xy-scale 2dup 1+ swap 1+ swap line LOOP 5 +TO cdiam cdiam center-x 30 - > IF 16 TO cdiam ! THEN ; : .hms ( -- ) *************** *** 321,341 **** 60 0 do white line-color ! i center-x 1 - xy-scale i 1+ center-x 1 - xy-scale line i center-x 12 - xy-scale i 1+ center-x 12 - xy-scale line i 5 mod if ltcyan line-color \ 1 second markers ! i center-x 12 - xy-scale i center-x 1 - xy-scale line else yellow line-color \ 5 second markers ! i center-x 20 - xy-scale i center-x 1 - xy-scale line then loop ; : new-clock ( -- ) \ draw a new clock, ! screen-width 2 / 1- TO center-x ! screen-height 2 / 1- TO center-y \ calibrate screen center center-x center-x center-y */ TO scale-y \ calibrate aspect ratio white line-color \ default color=white show-border ! show-circle ; \ display the circle : show-time ( -- ) \ show the time if it has changed --- 339,359 ---- 60 0 do white line-color ! i center-x 1- xy-scale i 1+ center-x 1- xy-scale line i center-x 12 - xy-scale i 1+ center-x 12 - xy-scale line i 5 mod if ltcyan line-color \ 1 second markers ! i center-x 12 - xy-scale i center-x 1- xy-scale line else yellow line-color \ 5 second markers ! i center-x 20 - xy-scale i center-x 1- xy-scale line then loop ; : new-clock ( -- ) \ draw a new clock, ! screen-width 2/ 1- TO center-x ! screen-height 2/ 1- TO center-y \ calibrate screen center center-x center-x center-y */ TO scale-y \ calibrate aspect ratio white line-color \ default color=white show-border ! show-circle ; \ display the circle : show-time ( -- ) \ show the time if it has changed *************** *** 351,356 **** Start: GCLOCK RANDOM-INIT \ initialize random numbers ! screen-width 2 / 1 - TO center-x ! screen-height 2 / 1 - TO center-y \ calibrate screen center white line-color \ default color=white new-clock --- 369,374 ---- Start: GCLOCK RANDOM-INIT \ initialize random numbers ! screen-width 2/ 1- TO center-x ! screen-height 2/ 1- TO center-y \ calibrate screen center white line-color \ default color=white new-clock *************** *** 374,379 **** delay-ms ms again ; ! ! ( with-img ) ' WinClock turnkey WinClock \ build an application on disk ! 5 pause-seconds --- 392,400 ---- delay-ms ms again ; ! false #if ! ' WinClock turnkey WinClock \ build an application on disk ! 1 pause-seconds ! #else ! WinClock ! #then |
