\ graphics for "henri poincare" \ \ hp_screen+ \ more elaborate screen and graphics classes to display "henri poincare" \ components. \ \ Based on ideas presented by Joel Ryan. \ \ code: Han-earl Park \ copyright 2004 buster & friends' C-ALTO Labs \ (Den haag, December 1997 - \ (Valencia, October 1998 - \ (Southampton, May 2000 - \ \ MOD: HeP 11/17/99 Started project. \ MOD: HeP 10/02/00 Add default qwerty key function. \ MOD: HeP 10/05/00 Use RAW.DRAW: and RAW.UNDRAW: methods. This makes \ subclassing a little easier. \ Provisional implementation of 3d ("oblique") drawing and \ HIGHLIGHT:ing. \ MOD: HeP 10/06/00 Implement frame (axis) methods. \ MOD: HeP 10/07/00 Can auto-center around window dimensions! \ Fix incorrect drawing of 3d oblique projections. \ MOD: HeP 10/08/00 Add a couple of instance variables to hold the coords of \ the oblique projection: no longer calculate those coords \ more than once. \ MOD: HeP 03-21-04 Cleanup code in GRP.3D.HIGHLIGHT and mark the axis (would \ have used dotted lines, but the diagonal sometimes goes \ missing). include? task-graph_plus myt:graph_plus include? task-device myt:device include? task-gr_view myt:gr_view include? task-hp_screen myt:hp_screen anew task-hp_screen+ method 2D.VIEW: method 3D.VIEW: :class OB.GR.PARTICLE+ iv-grp-3d-view? ;m :m 2D.VIEW: ( -- ) iv-grp-3d-view? IF iv-grp-visible? iv-grp-drawn? AND IF self RAW.UNDRAW: [] false iv=> iv-grp-3d-view? self RAW.DRAW: [] ELSE false iv=> iv-grp-3d-view? THEN THEN ;m :m 3D.VIEW: ( -- ) iv-grp-3d-view? NOT IF iv-grp-visible? iv-grp-drawn? AND IF self RAW.UNDRAW: [] true iv=> iv-grp-3d-view? self RAW.DRAW: [] ELSE true iv=> iv-grp-3d-view? THEN THEN ;m : GRP.3D.XY ( x y z -- x y , 2d oblique projection of 3d image ) 2/ rot over - -rot + ; : GRP.3D.HIGHLIGHT ( -- ) gr.mode@ gr_xor_mode gr.mode! \ hp-grsp-frame? @ IF 0 hp-grsp-frame-offset @ iv-grp-y iv-grp-z GRP.3D.XY gr.move iv-grp-3d-x iv-grp-3d-y gr.draw iv-grp-x 1 hp-grsp-frame-offset @ iv-grp-z GRP.3D.XY gr.draw iv-grp-3d-x iv-grp-3d-y gr.move iv-grp-x iv-grp-y 2 hp-grsp-frame-offset @ GRP.3D.XY gr.draw \ \ draw the axis \ \ "origin" gets reused 0 hp-grsp-frame-offset @ 1 hp-grsp-frame-offset @ 2 hp-grsp-frame-offset @ GRP.3D.XY \ the diagonal doesn't like to be dotted... 2dup gr.move \ to "origin" 0 hp-grsp-frame-offset @ 1 hp-grsp-frame-offset @ iv-grp-z GRP.3D.XY gr.draw \ ...but dot the rest GR.DOTTED.ON iv-grp-x 1 hp-grsp-frame-offset @ 2 hp-grsp-frame-offset @ GRP.3D.XY gr.move gr.draw \ to "origin" 0 hp-grsp-frame-offset @ iv-grp-y 2 hp-grsp-frame-offset @ GRP.3D.XY gr.draw GR.DOTTED.OFF ELSE iv-grp-3d-x 32 - iv-grp-3d-y gr.move iv-grp-3d-x 32 + iv-grp-3d-y gr.draw iv-grp-3d-x iv-grp-3d-y 32 - gr.move iv-grp-3d-x iv-grp-3d-y 32 + gr.draw iv-grp-3d-x 16 - iv-grp-3d-y 16 + gr.move iv-grp-3d-x 16 + iv-grp-3d-y 16 - gr.draw THEN \ gr.mode! ; : GRP.3D.BUBBLE ( -- ) gr.mode@ gr_xor_mode gr.mode! \ iv-grp-3d-x 16 - iv-grp-3d-y 8 - iv-grp-3d-x 16 + iv-grp-3d-y 8 + gr.oval \ gr.mode! ; : GRP.3D.TRACE ( -- ) hp_fground_color gr.color! \ iv-grp-3d-x iv-grp-3d-y gr.dot ; :m RAW.DRAW: ( -- ) iv-grp-3d-view? IF iv-grp-x iv-grp-y iv-grp-z GRP.3D.XY iv=> iv-grp-3d-y iv=> iv-grp-3d-x \ iv-grp-mode CASE fgr_bubble_mode OF grp.3d.bubble ENDOF fgr_trace_mode OF grp.3d.trace ENDOF ENDCASE \ iv-grp-highlight? IF grp.3d.highlight THEN ELSE raw.draw: super THEN ;m :m RAW.UNDRAW: ( -- ) iv-grp-3d-view? IF iv-grp-mode fgr_bubble_mode = IF grp.3D.bubble THEN \ iv-grp-highlight? IF grp.3d.highlight THEN ELSE raw.undraw: super THEN ;m ;class \ graphical space (screen) class :class OB.GR.SPACE+ x 0 -> y 0 -> z \ x y z add: shape \ empty: shape \ max.elements: shape 1- 0 DO x 8 choose choose+/- + gr_window_width 2/ mod -> x y 8 choose choose+/- + gr_window_height 2/ mod -> y z 8 choose choose+/- + 400 mod -> z x y z add: shape LOOP ; : HPSCR.TEST.INIT+ ( -- ) 128 3 new: shape-1 \ 64 0 DO 200 32 i 4* add: shape-1 LOOP \ 64 0 DO 200 32 64 i - 4* add: shape-1 LOOP \ 128 3 new: shape-2 shape-2 hpscr.test.shape+ 128 3 new: shape-3 shape-3 hpscr.test.shape+ 128 3 new: shape-4 shape-4 hpscr.test.shape+ \ " Test hp" put.title: test-grsp ascii H put.key: test-grsp test-grsp default-screen ! \ 5 new: test-grsp test-grp-1 add: test-grsp test-grp-2 add: test-grsp test-grp-3 add: test-grsp test-grp-4 add: test-grsp \ 8 put.duration: player-1 -1 put.dur.dim: player-1 1000 put.repeat: player-1 shape-1 test-grp-1 build: player-1 \ shape-2 test-grp-2 build: player-2 shape-3 test-grp-3 build: player-3 shape-4 test-grp-4 build: player-4 -1 put.dur.dim: player-2 -1 put.dur.dim: player-3 -1 put.dur.dim: player-4 8 put.duration: player-2 8 put.duration: player-3 8 put.duration: player-4 1000 put.repeat: player-2 1000 put.repeat: player-3 1000 put.repeat: player-4 \ 4 new: coll-p-1 player-1 add: coll-p-1 player-2 add: coll-p-1 player-3 add: coll-p-1 player-4 add: coll-p-1 ; : HPSCR.TEST.TERM+ ( -- ) free: test-grsp free.hierarchy: coll-p-1 ; if.forgotten hpscr.test.term+ : HPSCR.TEST+ ( -- ) hpscr.test.init+ coll-p-1 hmsl.play hpscr.test.term+ ; cr ." Enter HPSCR.TEST+ to test the hp_screen+ components." cr cr .THEN