\ screen+ \ \ class of screen with some additional (non-standard) functionality. \ \ code: Han-earl Park \ copyright 2004 buster & friends' C-ALTO Labs \ (Valencia, February 2000 - \ (Southampton, June 2000 - \ \ MOD: HeP 02/06/00 Started project. \ MOD: HeP 06/22/00 iv-sc-qwerty-cfa is set to zero at INIT: time. \ MOD: HeP 10/30/00 Reposition title. \ MOD: HeP 04-06-04 Set font and text size before drawing title. Also redraws \ title if it is changed. \ MOD: HeP 08-05-04 Redefine GR.CLEAR if myt:graph_plus isn't loaded anew task-screen+ exists? task-graph_plus NOT .IF \ taken from myt:graph_plus \ \ gr.clear is defined in hh:h4th_graph. That implementation uses gr_xmax \ and gr_ymax to set the erased area, but neither of these values depend \ on the window's actual dimensions (easily altered via resizing, etc). \ So, let's redefine it here using gr_window_width and gr_window_height \ instead. : GR.CLEAR ( -- , clear window ) gr.color@ 0 gr.color! gr.mode@ gr_insert_mode gr.mode! \ 0 0 gr_window_width gr_window_height gr.rect \ gr.mode! gr.color! ; .THEN method PUT.KEY.FUNCTION: :class OB.SCREEN+ iv-sc-qwerty-cfa ;m :m PUT.KEY.FUNCTION: ( cfa -- ) iv=> iv-sc-qwerty-cfa ;m :m KEY: ( char -- , process keyboard input ) iv-sc-qwerty-cfa IF rnow toupper self iv-sc-qwerty-cfa -2 exec.stack? ( char addr -- ) ELSE drop THEN ;m : SCREEN.UNDRAW.TITLE ( -- ) 0 gr.color! 0 gr.font! 12 gr.height! \ 40 200 scg.wc->dc 2+ dup 15 - swap 2 pick get.title: self count gr.textlen + 1+ swap GR.RECT ; : SCREEN.DRAW.TITLE ( -- ) 1 gr.color! 0 gr.font! 12 gr.height! 40 200 scg.move get.title: self gr.text ; :m PUT.TITLE: ( $ -- ) hmsl-window @ IF hmsl.set.window cg-current-screen @ self = IF gr.color@ \ -- $ color SCREEN.UNDRAW.TITLE over iv=> iv-sc-title SCREEN.DRAW.TITLE gr.color! \ -- $ THEN THEN iv=> iv-sc-title ;m : (SCREEN.DRAW)+ ( -- ) cg-drawing-screen @ 0= dup \ leave flag for OFF at end IF cg-drawing-screen on \ top level screen gr.clear 1 gr.color! \ don't clear if sub-screen THEN service.tasks \ 0 scg.selnt \ set normalization transform for CGs iv-sc-draw-cfa ?dup IF 0 exec.stack? THEN service.tasks \ SCREEN.DRAW.TITLE \ MOD: HeP \ many: self ?dup IF 0 DO i get: self 2dup + 0> \ specify x,y ? IF 2 pick put.xy: [] \ set x,y of control ELSE 2drop THEN \ -- control|subscreen \ add screen offsets for subscreen iv-scr-leftx iv-scr-topy + 0> IF dup>r get.xy.dc: [] >r iv-scr-leftx + \ add offsets r> iv-scr-topy + r@ put.xy.dc: [] \ 00006 r> THEN draw: [] service.tasks LOOP ELSE " DRAW: in OB.SCREEN+" " No controls!" er_return er.report THEN IF cg-drawing-screen off self cg-current-screen ! THEN ; :m DRAW: ( -- , draw all the control objects ) hmsl-window @ IF hmsl.set.window cg-current-screen @ ?dup IF undraw: [] THEN (screen.draw)+ true iv=> iv-sc-drawn ELSE " DRAW: SCREEN+" " No window to DRAW: in!" er_fatal er.report cg-current-screen off THEN ;m :m PRINT: ( -- ) print: super ." KEY function = " iv-sc-qwerty-cfa cfa. cr ;m ;class